asked on

Implement SendTo functionality in Visual Basic (Execute a .LNK)

Hi Experts,

I am interested in implementing Windows SendTo functionality in a visual basic application.

If you ever have an item on a desktop you can
right click on it and and send it to a variety
of links such as:

A drive
Outlook Recipient
Notepad
etc.

This is done by launching the links found in the
windows SendTo directory with the appropriate files.

I have been able to find out what the links are in
the SendTo directory with the API call SHGetSpecialFolder
now I have a problem launching the link files.

These .LNK files must somehow have simulated a drag drop
operation onto them or some sort of ShellExecute(Ex)
command to make them work.

One example to simplify my problem here is:

If I have a shortcut to the floppy disk (A Drive)
anywhere , what API calls can I use to execute this .LNK
file to send "AutoExec.Bat" to the A drive.

(This is just an example, the link may do anything)

Please help !

wpsjr1

If the SendTo shortcut is an application, windows sends the filename that is drag/dropped to the application. In that case you would Shell() to the app and pass the filename as a param. If the SendTo shortcut is a drive (a:\) then the file is copied. In which case you could use filecopy. You'll need to get the target of the lnk using the IShellLink interface. Then determine if its a Drive by checking for If Right$(sTarget) = "\". I'm not really sure howto handle .des or .map files, perhaps ShellExecute. I'll get the IShellLink code together shortly. (no pun intended ;)

wpsjr1

This is from the VB5 CD, I've altered is a bit to run in a class instead of a DLL. Might be a few mods I was playing around with too :)

' begin cShellLink.cls

Option Explicit

Private Declare Sub RtlMoveMemory Lib "kernel32" (dest As Any, src As Any, ByVal cb&)

Public Enum STGM
STGM_DIRECT = &H0&
STGM_TRANSACTED = &H10000
STGM_SIMPLE = &H8000000
STGM_READ = &H0&
STGM_WRITE = &H1&
STGM_READWRITE = &H2&
STGM_SHARE_DENY_NONE = &H40&
STGM_SHARE_DENY_READ = &H30&
STGM_SHARE_DENY_WRITE = &H20&
STGM_SHARE_EXCLUSIVE = &H10&
STGM_PRIORITY = &H40000
STGM_DELETEONRELEASE = &H4000000
STGM_CREATE = &H1000&
STGM_CONVERT = &H20000
STGM_FAILIFTHERE = &H0&
STGM_NOSCRATCH = &H100000
End Enum

Public Enum SHELLFOLDERS ' Shell Folder Path Constants...
CSIDL_DESKTOP = &H0& ' ..\WinNT\profiles\username\Desktop
CSIDL_PROGRAMS = &H2& ' ..\WinNT\profiles\username\Start Menu\Programs
CSIDL_CONTROLS = &H3& ' No Path
CSIDL_PRINTERS = &H4& ' No Path
CSIDL_PERSONAL = &H5& ' ..\WinNT\profiles\username\Personal
CSIDL_FAVORITES = &H6& ' ..\WinNT\profiles\username\Favorites
CSIDL_STARTUP = &H7& ' ..\WinNT\profiles\username\Start Menu\Programs\Startup
CSIDL_RECENT = &H8& ' ..\WinNT\profiles\username\Recent
CSIDL_SENDTO = &H9& ' ..\WinNT\profiles\username\SendTo
CSIDL_BITBUCKET = &HA& ' No Path
CSIDL_STARTMENU = &HB& ' ..\WinNT\profiles\username\Start Menu
CSIDL_DESKTOPDIRECTORY = &H10& ' ..\WinNT\profiles\username\Desktop
CSIDL_DRIVES = &H11& ' No Path
CSIDL_NETWORK = &H12& ' No Path
CSIDL_NETHOOD = &H13& ' ..\WinNT\profiles\username\NetHood
CSIDL_FONTS = &H14& ' ..\WinNT\fonts
CSIDL_TEMPLATES = &H15& ' ..\WinNT\ShellNew
CSIDL_COMMON_STARTMENU = &H16& ' ..\WinNT\profiles\All Users\Start Menu
CSIDL_COMMON_PROGRAMS = &H17& ' ..\WinNT\profiles\All Users\Start Menu\Programs
CSIDL_COMMON_STARTUP = &H18& ' ..\WinNT\profiles\All Users\Start Menu\Programs\Startup
CSIDL_COMMON_DESKTOPDIRECTORY = &H19& '..\WinNT\profiles\All Users\Desktop
CSIDL_APPDATA = &H1A& ' ..\WinNT\profiles\username\Application Data
CSIDL_PRINTHOOD = &H1B& ' ..\WinNT\profiles\username\PrintHood
End Enum

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

Public Function GetSystemFolderPath(ByVal hwnd As Long, ByVal Id As Integer, sfPath As String) As Boolean
Dim rc As Long ' Return code
Dim pidl As Long ' ptr to Item ID List
Dim cbPath As Long ' char count of path
Dim szPath As String ' String var for path

szPath = String$(MAX_PATH, 0) ' Pre-allocate path string for api call

rc = SHGetSpecialFolderLocation(hwnd, Id, pidl) ' Get pidl for Id...
If (rc = 0) Then ' If success is 0
#If UNICODE Then
rc = SHGetPathFromIDList(pidl, StrPtr(szPath)) ' Get Path from Item Id List
#Else
rc = SHGetPathFromIDList(pidl, szPath) ' Get Path from Item Id List
#End If
If (rc = 1) Then ' If success is 1
sfPath = Left$(szPath, InStr(1, szPath, vbNullChar) - 1)
' szPath = Trim$(szPath) ' Fix path string
' cbPath = Len(szPath) ' Get length of path
' If (Asc(Right(szPath, 1)) = 0) Then cbPath = cbPath - 1 ' Adjust path length
' If (cbPath > 0) Then sfPath = Left$(szPath, cbPath) ' Adjust path string variable
GetSystemFolderPath = True ' Return success
End If
End If
End Function

Public Function CreateShellLink(LnkFile As String, ExeFile As String, WorkDir As String, _
ExeArgs As String, IconFile As String, IconIdx As Long, _
ShowCmd As SHOWCMDFLAGS) As Boolean

Dim rc As Long
Dim pidl As Long ' Item id list
Dim dwReserved As Long ' Reserved flag
Dim cShellLink As ShellLinkA ' An explorer IShellLinkA(Win 95/Win NT) instance
Dim cPersistFile As IPersistFile ' An explorer IPersistFile instance

If ((LnkFile = "") Or (ExeFile = "")) Then Exit Function ' Validate min. input requirements.

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 (LnkDesc <> "") then .SetDescription pszName ' Set shortcut description
' .SetHotkey wHotKey

'.SetHotkey 513

If (IconFile <> "") Then .SetIconLocation IconFile, IconIdx ' Set shortcut icon location & index
Dim s$
s = "ShellLink"

.SetDescription "ShellLink" & vbNullChar
' .SetIDList pidl
' dwReserved = 0
' SetRelativePath pszPathRel dwReserved

.SetShowCmd ShowCmd ' Set shortcut's startup mode (min,max,normal)
End With

cShellLink.Resolve 0, SLR_UPDATE
cPersistFile.Save StrConv(LnkFile, vbUnicode), 0 ' Unicode conversion hack... This must be done!
CreateShellLink = True ' Return Success

ErrHandler:
Set cPersistFile = Nothing ' Destroy Object
Set cShellLink = Nothing ' Destroy Object
End Function

Public Function GetShellLinkInfo(LnkFile As String, Optional ExeFile As String, Optional WorkDir As String, _
Optional ExeArgs As String, Optional IconFile As String, Optional IconIdx As Long, _
Optional ShowCmd As Long) As Boolean

Dim pidl As Long ' Item id list
Dim wHotKey As Long ' Hotkey to shortcut...
Dim fd As WIN32_FIND_DATA
Dim Description As String
Dim buffLen As Long
Dim cShellLink As ShellLinkA ' An explorer IShellLink instance
Dim cPersistFile As IPersistFile ' An explorer IPersistFile instance

If (LnkFile = "") Then Exit Function ' Validate min. input requirements.

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

' Load Shortcut file...(must do this UNICODE hack!)
On Error GoTo ErrHandler
cPersistFile.Load StrConv(LnkFile, vbUnicode), STGM_DIRECT

With cShellLink
' Get command line exe name & path of shortcut
ExeFile = String$(MAX_PATH, 0)
buffLen = Len(ExeFile)
.GetPath ExeFile, buffLen, fd, SLGP_UNCPRIORITY

Dim s As String
s = fd.cFileName ' Not returned to calling function

' Get working directory of shortcut
WorkDir = String$(MAX_PATH, 0)
buffLen = Len(WorkDir)
.GetWorkingDirectory WorkDir, buffLen

' Get command line arguments of shortcut
ExeArgs = String$(MAX_PATH, 0)
buffLen = Len(ExeArgs)
.GetArguments ExeArgs, buffLen

' Get description of shortcut
Description = String$(MAX_PATH, 0)
buffLen = Len(Description)
.GetDescription Description, buffLen ' Not returned to calling function
Debug.Print Description
' Get the HotKey for shortcut
.GetHotkey wHotKey ' Not returned to calling function
Debug.Print wHotKey & " HOTKEY"

' Get shortcut icon location & index
IconFile = String$(MAX_PATH, 0)
buffLen = Len(IconFile)
.GetIconLocation IconFile, buffLen, IconIdx

' Get Item ID List...
.GetIDList pidl ' Not returned to calling function
Debug.Print pidl & " pidl"
' Set shortcut's startup mode (min,max,normal)
.GetShowCmd ShowCmd
End With

GetShellLinkInfo = True ' Return Success
ErrHandler:
Set cPersistFile = Nothing ' Destroy Object
Set cShellLink = Nothing ' Destroy Object
End Function

' end cShellLink.cls

'---------------------------------

' begin modShellLink.bas

Option Explicit

'#define HOTKEYF_SHIFT 0x01
'#define HOTKEYF_CONTROL 0x02
'#define HOTKEYF_ALT 0x04
'#define HOTKEYF_EXT 0x08

#If UNICODE Then
Public Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListW" (ByVal pidl As Long, ByVal szPath As Long) As Long
#Else
Public Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal szPath As String) As Long
#End If

Public Declare Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hwndOwner As Long, ByVal nFolder As Integer, ppidl As Long) As Long

Public Const MAX_PATH = 260
Public Const MAX_NAME = 40

You'll also need a typelib for the IShellLink and IPersistFile interfaces.

http://www.syix.com/wpsjr1/shelllnk.tlb

Let me know how this works out. :)

Paul

delloro

ASKER

Thanks for this, do you think that we can simulate a dragdrop operation to achieve this in a simpler manner ?

ASKER CERTIFIED SOLUTION

wpsjr1

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

delloro

ASKER

Sorry for the delay.