• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1146
  • Last Modified:

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 !

 
0
delloro
Asked:
delloro
  • 3
  • 2
1 Solution
 
wpsjr1Commented:
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 ;)
0
 
wpsjr1Commented:
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

0
 
delloroAuthor Commented:
Thanks for this, do you think that we can simulate a dragdrop operation to achieve this in a simpler manner ?
0
 
wpsjr1Commented:
I think the code would probably end up being more complicated, but you might look into the IContextMenu, IContextMenu2 and IDataObject interfaces.  Edanmo's page has info at: http://www.domaindlx.com/e_morcillo/search.asp?keys=icontextmenu&c=1

and

http://www.domaindlx.com/e_morcillo/search.asp?keys=idataobject&c=1

Good Luck :)

Paul
0
 
delloroAuthor Commented:
Sorry for the delay.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now