Not a Member Yet,
Click here to Register
How do you like the new design?






ID: 155
Viewed: 2666
Added: Apr 29, 2002
Version:
Snippet uploaded by: snippet
Written By: unknown
Demo: Sorry, no demo



User Rated at: 0 Stars
Rate This:

Thank you for your vote. Please wait...

It appears you already voted for this snippet

It appears your vote value was empty

From a UseNet Posting, Author Details Lost To get the desktop folder: HK = HKEY_CURRENT_USER buff = "softwaremicrosoftwindowscurrentversionexplorershell folders" ret = RegOpenKeyEx(HK, buff, 0, KEY_QUERY_VALUE, pl) buff = String(127, 0): bf = 128 ret = RegQueryValueEx(pl, "Desktop", 0, REG_SZ, buff, bf) buff = Left$(buff, bf - 1) TMPDesk = buff & "" Now TMPDesk containts the right path to desktop folder. Than: You need to make a reference to "Shelllnk.tlb" in your project. You'll find it at VB-CD under "VB5ToolsUnsupprtShelllnk" folder. It *must* be. Then you can create a shortcut anywhere on your computer by using the following function (for more information see sample code in the named folder):

Highlight all by clicking in box
<!---Declaration--->
Option Explicit

Dim IconCount As Long
Dim DesktopHandle As Long

Public Enum SHOWCMDFLAGS
SHOWNORMAL = 5
SHOWMAXIMIZE = 3
SHOWMINIMIZE = 7
End Enum


Public Function CreateShellLink&(LnkName$, ExeFile$, WorkDir$, ExeArgs$, _
Iconfile$, IconIdx&, ShowCmd As SHOWCMDFLAGS)
Dim LnkFile$ ' LinkName & extension
Dim myPath$ ' Application path
Dim cShellLink As ShellLinkA ' An explorer IShellLinkA(Win 95/Win98/WinNT) instance
Dim cPersistFile As IPersistFile ' An explorer IPersistFile instance
Dim hwnd&
Const lnk$ = ".lnk" ' Link extension
'----------------------------------------------
If LnkName = "" Or ExeFile = "" Then
Exit Function ' Validate min. input requirements.
End If

myPath = App.path
If Right$(myPath, 1) <> "" Then myPath = myPath & ""

LnkFile = IIf(InStr(LnkName, ""), LnkName & lnk, myPath & LnkName & lnk)
'-----------------------------------------------
''# Search the Desktop Handle
' hwnd = FindWindow("progman", "program manager")
' hwnd = FindWindowEx(hwnd, 0, "shelldll_defview", vbNullString)
' DesktopHandle = FindWindowEx(hwnd, 0, "syslistview32", vbNullString)
' '# Count Icons
' IconCount = SendMessageByLong(DesktopHandle, LVM_GETITEMCOUNT, 0, 0)
'------------------------------------
CreateShellLink = False ' Preset Return Unsuccess
On Error GoTo ErrHandler

Set cShellLink = New ShellLinkA ' Create new IShellLink interface
Set cPersistFile = cShellLink ' Implement cShellLink's IPersistFile interface

With cShellLink
.SetPath ExeFile ' set command line exe name & path to new ShortCut
If (WorkDir <> "") Then .SetWorkingDirectory WorkDir ' Set working directory in shortcut
If (ExeArgs <> "") Then .SetArguments ExeArgs ' Add arguments to command line
If (Iconfile <> "") Then .SetIconLocation Iconfile, IconIdx ' Set shortcut icon location & index
.SetShowCmd IIf(ShowCmd = 0, SHOWNORMAL, ShowCmd) ' Set shortcut's startup mode
End With

cShellLink.Resolve 0, SLR_UPDATE
cPersistFile.Save StrConv(LnkFile, vbUnicode), 0 ' Unicode conversion back... This must be done!
CreateShellLink = True ' Return Success
'-------------------------------------------
ErrHandler:
'---------------------------------------------
Set cPersistFile = Nothing ' Destroy Object
Set cShellLink = Nothing ' Destroy Object
'-----------------------------------------
End Function

Highlight All
<!---Code--->
none;


No Comments to show

Please completely fill out the form below if you want to review this snippet. All reviews are subject to validation.


Replying to a Comment...


Adding your comment. Please wait...

Thanks for adding your comment!. After further review it will be added.

There was a problem adding your comment. Please try again.

Please complete all the fields in the form before sending.

© 2002 - 2017 snippetlibrary.com All Rights Reserved. Conditions