Solved

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

Posted on 2001-06-10
5
1,120 Views
Last Modified: 2013-11-25
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
Comment
Question by:delloro
  • 3
  • 2
5 Comments
 
LVL 3

Expert Comment

by:wpsjr1
Comment Utility
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
 
LVL 3

Expert Comment

by:wpsjr1
Comment Utility
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
 
LVL 1

Author Comment

by:delloro
Comment Utility
Thanks for this, do you think that we can simulate a dragdrop operation to achieve this in a simpler manner ?
0
 
LVL 3

Accepted Solution

by:
wpsjr1 earned 130 total points
Comment Utility
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
 
LVL 1

Author Comment

by:delloro
Comment Utility
Sorry for the delay.
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now