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
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    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; 14 Apr 2021, 09:02 PM.
    Tags: None
Previous template Next
Working...
X

We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

I Agree