Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Shortcut creation and query

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Shortcut creation and query

    *Shortcut creation and query
    .Lnk Shortcut link files creation and information

    Following code try to put complete shortcut functions
    in a consize and easy to use format.

    Thank to Semen Matusovski, José Roca, Peter Redei, Wayne Diamond,
    Florent Heyworth, George Bleck and Patrice Terrier.

    Pierre

    Code:
    'Functions:
    ' LinkCreate           : Creation of a shortcut .lnk file
    ' LinkQuery            : Query a shortcut .lnk file for info
    ' LinkDataToString     : Convert a LinkType variable to a human readeable string
    ' FolderGet            : Get a folder from a CLSID
    ' FolderQuickLaunchGet : Get the QuickLaunch toolbar path
     
    'Info that can be set or retreive from a .lnk file are
    ' target .exe path and name, arguments, working directory,
    ' show flag, comment, icon path and index, hotkey
     
    #COMPILE EXE '#Win 8.04#
    #DIM ALL
    #INCLUDE "Win32Api.inc"
     
    '%HOTKEYF_* From CommCtrl.inc
    %HOTKEYF_SHIFT   = 1
    %HOTKEYF_CONTROL = 2
    %HOTKEYF_ALT     = 4
    %HOTKEYF_EXT     = 8
     
    %CIS                  = 1 'Component is allowed in the same process space.
    $IID_IPersistFile     = GUID$("{0000010B-0000-0000-C000-000000000046}") 'CHR$( 11,  1, 0, 0, 0, 0, 0, 0, 192, 0, 0, 0, 0, 0, 0, 70)
    $CLSID_ShellLink      = GUID$("{00021401-0000-0000-C000-000000000046}") 'CHR$(  1, 20, 2, 0, 0, 0, 0, 0, 192, 0, 0, 0, 0, 0, 0, 70)
    $IID_IShellLinkAnsi   = GUID$("{000214EE-0000-0000-C000-000000000046}") 'CHR$(238, 20, 2, 0, 0, 0, 0, 0, 192, 0, 0, 0, 0, 0, 0, 70)
    '$IID_IShellLinkA     = GUID$("{000214EE-0000-C000-0000-000000000046}")
    '$IID_IShellLinkW     = GUID$("{000214F9-0000-C000-0000-000000000046}")
     
    DECLARE FUNCTION F1(P1 AS ANY) AS DWORD
    DECLARE FUNCTION F2(P1 AS ANY, P2 AS ANY) AS DWORD
    DECLARE FUNCTION F3(P1 AS ANY, P2 AS ANY, P3 AS ANY) AS DWORD
    DECLARE FUNCTION F4(P1 AS ANY, P2 AS ANY, P3 AS ANY, P4 AS ANY) AS DWORD
    DECLARE FUNCTION F5(P1 AS ANY, P2 AS ANY, P3 AS ANY, P4 AS ANY, P5 AS ANY) AS DWORD
     
    TYPE LinkType
      zLinkFolder  AS ASCIIZ * %MAX_PATH 'Folder holding the .LNK file
      zLinkName    AS ASCIIZ * %MAX_PATH 'Shortcut .LNK file name
      zExeName     AS ASCIIZ * %MAX_PATH 'Target .exe path and name
      zArguments   AS ASCIIZ * %MAX_PATH 'Arguments
      zWorkDir     AS ASCIIZ * %MAX_PATH 'Working directory
      ShowFlag     AS DWORD              'Show flag: %SW_SHOWNORMAL %SW_MAXIMIZE %SW_SHOWMINIMIZED
      zComment     AS ASCIIZ * %MAX_PATH 'Comment
      zIconFile    AS ASCIIZ * %MAX_PATH 'Icon path, $NUL for current .exe icon
      IconIndex    AS DWORD              'Icon index, zero based
      zHotKey      AS ASCIIZ * 2         'Hotkey letter
      casHotKey    AS WORD               'Hotkey Control, Alt and Shift state: %HOTKEYF_SHIFT %HOTKEYF_CONTROL %HOTKEYF_ALT %HOTKEYF_EXT
    END TYPE
    '______________________________________________________________________________
     
    FUNCTION ExeName() AS STRING
     LOCAL FileName    AS ASCIIZ * %Max_Path
     LOCAL FileNameLen AS LONG
     
     FileNameLen = GetModuleFileName(BYVAL %NULL, FileName, %Max_Path)
     FUNCTION = LEFT$(FileName, FileNameLen)
     
    END FUNCTION
    '______________________________________________________________________________
     
    FUNCTION FolderGet(CSIDL AS DWORD) AS STRING
     LOCAL pItemIdList AS ITEMIDLIST POINTER
     LOCAL zBuffer     AS ASCIIZ * %MAX_PATH
     
     IF SHGetSpecialFolderLocation(BYVAL %HWND_DESKTOP, BYVAL CSIDL, pItemIdList) = %NO_ERROR THEN
       IF SHGetPathFromIDList(BYVAL pItemIdList, zBuffer) THEN 'Returns TRUE if successful
         IF ASC(zBuffer, -1) <> 92 THEN zBuffer = zBuffer & "\"
         FUNCTION = zBuffer '& "\"
       END IF
       CoTaskMemFree(BYVAL pItemIdList)
     END IF
     
    END FUNCTION
    '______________________________________________________________________________
     
    FUNCTION FolderQuickLaunchGet() AS STRING
     
      FUNCTION = FolderGet(%CSIDL_APPDATA) & "Microsoft\Internet Explorer\Quick Launch\"
     
    END FUNCTION
    '______________________________________________________________________________
     
    FUNCTION LinkDataToString(BYREF Link AS LinkType)AS STRING
     
     FUNCTION = "Link folder :"    & $TAB & Link.zLinkFolder                  & $CRLF & _
                "Link name :"      & $TAB & Link.zLinkName                    & $CRLF & _
                "Exe name :"       & $TAB & Link.zExeName                     & $CRLF & _
                "Arguments :"      & $TAB & Link.zArguments                   & $CRLF & _
                "Working folder :" & $TAB & Link.zWorkDir                     & $CRLF & _
                "Show flag :"      & $TAB & CHOOSE$(Link.ShowFlag, _
                  "Normal", "Minimize", "Maximize", "NoActivate", "Show", _
                  "Minimize", "MinNoActivate", "ShowNa", "Restore", "Default", _
                  "ForceMinimize") & " (" & FORMAT$(Link.ShowFlag) & ")"      & $CRLF & _
                "Comment :"        & $TAB & Link.zComment                     & $CRLF & _
                "Icon file :"      & $TAB & $TAB & Link.zIconFile             & $CRLF & _
                "Icon index :"     & $TAB & FORMAT$(Link.IconIndex)           & $CRLF & _
                "Hotkey :"         & $TAB & $TAB & _
                  IIF$((Link.casHotKey AND %HOTKEYF_SHIFT)  , "Shift "  , "") & _
                  IIF$((Link.casHotKey AND %HOTKEYF_CONTROL), "Control ", "") & _
                  IIF$((Link.casHotKey AND %HOTKEYF_ALT)    , "Alt "    , "") & _
                  IIF$((Link.casHotKey AND %HOTKEYF_EXT)    , "Ext "    , "") & _
                  Link.zHotKey
     
    END FUNCTION
    '______________________________________________________________________________
     
    FUNCTION LinkQuery(BYREF Link AS LinkType)AS LONG
     LOCAL IID_Persist     AS GUID
     LOCAL CLSID_ShellLink AS GUID
     LOCAL IID_IShellLink  AS GUID
     LOCAL FileData        AS WIN32_FIND_DATA
     LOCAL zBuffer         AS ASCIIZ * %MAX_PATH
     LOCAL wzBuffer        AS STRING * %MAX_PATH * 2
     LOCAL PP              AS DWORD POINTER
     LOCAL PPF             AS DWORD POINTER
     LOCAL PSL             AS DWORD POINTER
     LOCAL Flags           AS DWORD
     LOCAL HotKey          AS DWORD
     LOCAL Retval          AS LONG
     
     CLSID_ShellLink = $CLSID_ShellLink
     IID_IShellLink  = $IID_IShellLinkAnsi
     IID_Persist     = $IID_IPersistFile
     
     IF CoCreateInstance(CLSID_ShellLink, BYVAL %Null, %CIS, IID_IShellLink, PSL) = %S_OK THEN
       PP = @PSL : CALL DWORD @PP USING F3(BYVAL PSL, IID_Persist, PPF) TO Retval
       zBuffer =  Link.zLinkFolder & Link.zLinkName
       Retval = MultiByteToWideChar(%CP_ACP, 0, zBuffer, -1, BYVAL VARPTR(wzBuffer), %MAX_PATH * 2)
       PP = @PPF + 20 : CALL DWORD @PP USING F3(BYVAL PPF, wzBuffer, BYVAL %True) 'SetIDList
       PP = @PSL + 12 : CALL DWORD @PP USING F5(BYVAL PSL, Link.zExeName, BYVAL %MAX_PATH, FileData, Flags) 'Get Path & zExeName
       IF LEN(Link.zExeName) THEN
         FUNCTION = %TRUE
         PP = @PSL + 24 : CALL DWORD @PP USING F5(BYVAL PSL, Link.zComment, BYVAL %MAX_PATH, FileData, Flags) 'Comment
         PP = @PSL + 32 : CALL DWORD @PP USING F5(BYVAL PSL, Link.zWorkDir, BYVAL %MAX_PATH, FileData, Flags) 'WorkDir
         PP = @PSL + 40 : CALL DWORD @PP USING F5(BYVAL PSL, Link.zArguments, BYVAL %MAX_PATH, FileData, Flags) 'Argument
         PP = @PSL + 48 : CALL DWORD @PP USING F2(BYVAL PSL, Hotkey) 'HotKey: %HOTKEYF_SHIFT=1 HOTKEYF_CONTROL=2  %HOTKEYF_ALT=4 % %HOTKEYF_EXT=8
         Link.zHotKey = CHR$(LO(WORD, Hotkey))
         Link.casHotKey = HI(BYTE, Hotkey)
         PP = @PSL + 56 : CALL DWORD @PP USING F2(BYVAL PSL, Link.ShowFlag) 'Show Normal-Maximize-Minimize
         PP = @PSL + 64 : CALL DWORD @PP USING F4(BYVAL PSL, Link.zIconFile, BYVAL %MAX_PATH, Link.IconIndex) 'External icon file and index
       END IF
       PP = @PPF + 8: CALL DWORD @PP USING F1( BYVAL PPF ) 'Release the persistant file
       PP = @PSL + 8: CALL DWORD @PP USING F1( BYVAL PSL ) 'Unbind the shell link object from the persistent file
     END IF
     
    END FUNCTION
    '______________________________________________________________________________
     
    FUNCTION LinkCreate(BYREF Link AS LinkType)AS LONG
     LOCAL PSL              AS DWORD POINTER            'IShellLink interface reference
     LOCAL PPF              AS DWORD POINTER            'IPersistFile interrace reference
     LOCAL PP               AS DWORD POINTER
     LOCAL CLSID_ShellLink  AS GUID                     'ShellLink class identifier
     LOCAL IID_IShellLink   AS GUID                     'IShellLink interface identifier
     LOCAL IID_IPersistFile AS GUID                     'IPersistFile interface identifier
     LOCAL wzBuffer         AS STRING * %MAX_PATH * 2   'Wide Name of the .LNK file
     LOCAL zBuffer          AS ASCIIZ * %MAX_PATH       'Name of the .LNK file
     LOCAL Retval           AS LONG                     'Function return value
     
     CLSID_ShellLink  = $CLSID_ShellLink
     IID_IShellLink   = $IID_IShellLinkAnsi
     IID_IPersistFile = $IID_IPersistFile
     
     IF CoCreateInstance(CLSID_ShellLink, BYVAL %NULL, %CIS, IID_IShellLink, PSL) = %S_OK THEN
       PP = @PSL + 80 : CALL DWORD @PP USING F2(BYVAL PSL, Link.zExeName)
       PP = @PSL + 44 : CALL DWORD @PP USING F2(BYVAL PSL, Link.zArguments)
       PP = @PSL + 36 : CALL DWORD @PP USING F2(BYVAL PSL, Link.zWorkDir)
       PP = @PSL + 60 : CALL DWORD @PP USING F2(BYVAL PSL, BYVAL Link.ShowFlag)
       PP = @PSL + 28 : CALL DWORD @PP USING F2(BYVAL PSL, Link.zComment)
       PP = @PSL + 68 : CALL DWORD @PP USING F3(BYVAL PSL, Link.zIconFile, BYVAL Link.IconIndex)
       PP = @PSL + 52 : CALL DWORD @PP USING F2(BYVAL PSL, BYVAL ASC(Link.zHotKey) + (256 * Link.casHotKey))
       PP = @PSL : CALL DWORD @PP USING F3(BYVAL PSL, IID_IPersistFile, PPF) TO Retval
       IF Retval = %S_OK THEN
         IF ASC(Link.zLinkFolder, -1) <> 92 THEN Link.zLinkFolder = Link.zLinkFolder & "\"
         zBuffer = Link.zLinkFolder & Link.zLinkName 'Should end with .lnk
         MultiByteToWideChar %CP_ACP, 0, zBuffer, -1, BYVAL VARPTR(wzBuffer), %MAX_PATH * 2
         PP = @PPF + 24 : CALL DWORD @PP USING F3(BYVAL PPF, wzBuffer, BYVAL %True) TO Retval
         IF Retval = 0 THEN FUNCTION = %TRUE
         PP = @PPF + 8  : CALL DWORD @PP USING F1(BYVAL PPF) 'Release the persistant file
       END IF
       PP = @PSL + 8 : CALL DWORD @PP USING F1(BYVAL PSL) 'Unbind the shell link object from the persistent file
     END IF
     
    END FUNCTION
    '______________________________________________________________________________
     
    FUNCTION PBMAIN
     LOCAL NewLink  AS LinkType
     LOCAL LinkData AS LinkType
     LOCAL sBuffer  AS STRING
     LOCAL Retval   AS LONG
     
    'Create shortcut - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    'NewLink.zLinkFolder  = "C:\"                               'Path for link file
    'NewLink.zLinkFolder  = FolderGet(%CSIDL_COMMON_STARTUP)    'Desktop path for link file
    'NewLink.zLinkFolder  = FolderGet(%CSIDL_COMMON_PROGRAMS)   'Desktop path for link file
    'NewLink.zLinkFolder  = FolderQuickLaunchGet                'Path for link file
     NewLink.zLinkFolder  = FolderGet(%CSIDL_DESKTOP)           'Desktop path for link file
     NewLink.zLinkName    = "New shortcut.lnk"                  'Shortcut name
     NewLink.zExeName     = ExeName                             'Executable file path and name
     NewLink.zArguments   = "Some arguments"                    'Arguments
     NewLink.zWorkDir     = CURDIR$                             'Working directory
     NewLink.ShowFlag     = %SW_NORMAL                          'Show flag: %SW_SHOWNORMAL %SW_MAXIMIZE %SW_SHOWMINIMIZED
     NewLink.zComment     = "Some comment"                      'Comment
     NewLink.zIconFile    = "C:\WINDOWS\system32\moricons.dll"  'Icon file path, $NUL for current file icon
     NewLink.IconIndex    = 107                                 'Icon index, 0 based
     NewLink.zHotKey      = "Y"                                 'Hotkey ascii letter
     NewLink.casHotKey    = %HOTKEYF_CONTROL OR %HOTKEYF_SHIFT  'Hotkey Control-Alt-Shift state:   '%HOTKEYF_SHIFT=1 HOTKEYF_CONTROL=2  %HOTKEYF_ALT=4 % %HOTKEYF_EXT=8
     
     sBuffer = LinkDataToString(NewLink)
     Retval = LinkCreate(NewLink)
     IF Retval THEN
       Sbuffer = Sbuffer & $CRLF & $CRLF & " LinkCreate : " & $TAB & "Success"
     ELSE
       Sbuffer = Sbuffer & $CRLF & $CRLF & " LinkCreate : " & $TAB & "Failed"
     END IF
     MessageBox %HWND_DESKTOP, BYCOPY sBuffer, BYCOPY "Link create", %MB_ICONINFORMATION OR %MB_OK
     
     'Get shortcut info - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     LinkData.zLinkName   =  NewLink.zLinkName
     LinkData.zLinkFolder =  NewLink.zLinkFolder
     Retval = LinkQuery(LinkData)
     sBuffer = "Query on " & $TAB        & LinkData.zLinkName   & $CRLF & _
               "in folder" & $TAB & $TAB & LinkData.zLinkFolder & $CRLF & _
               $CRLF & LinkDataToString(LinkData)
     IF Retval THEN
       Sbuffer = Sbuffer & $CRLF & $CRLF & " LinkQuery : " & $TAB & "Success"
     ELSE
       Sbuffer = Sbuffer & $CRLF & $CRLF & " LinkQuery : " & $TAB & "Failed"
     END IF
     MessageBox %HWND_DESKTOP, BYCOPY sBuffer, BYCOPY "Link query", %MB_ICONINFORMATION OR %MB_OK
     
    END FUNCTION
    '______________________________________________________________________________
    '
    Last edited by Pierre Bellisle; 5 May 2016, 07:18 PM.
Working...
X