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

CreateShortcut subroutine (COM)

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • José Roca
    replied
    The index for SetIconLocation is 17, not 20. Here is the complete list:

    Code:
    ' ########################################################################################
' IShellLink interface
' IID = 000214EE-0000-0000-C000-000000000046
' ########################################################################################

' ========================================================================================
' Retrieves the path and file name of a Shell link object.
' ========================================================================================
FUNCTION IShellLink_GetPath (BYVAL pthis AS DWORD PTR, BYREF pszFile AS ASCIIZ, BYVAL cch AS LONG, BYREF pfd AS WIN32_FIND_DATA, BYVAL fFlags AS DWORD) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[3] USING IShellLink_GetPath (pthis, pszFile, cch, pfd, fFlags) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves the list of item identifiers for a Shell link object.
' ========================================================================================
FUNCTION IShellLink_GetIDList (BYVAL pthis AS DWORD PTR, BYREF ppidl AS DWORD) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[4] USING IShellLink_GetIDList (pthis, ppidl) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets the pointer to an item identifier list (PIDL) for a Shell link object.
' ========================================================================================
FUNCTION IShellLink_SetIDList (BYVAL pthis AS DWORD PTR, BYVAL ppidl AS DWORD) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[5] USING IShellLink_SetIDList (pthis, ppidl) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves the description string for a Shell link object.
' ========================================================================================
FUNCTION IShellLink_GetDescription (BYVAL pthis AS DWORD PTR, BYREF pszName AS ASCIIZ, BYVAL cch AS DWORD) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[6] USING IShellLink_GetDescription (pthis, pszName, cch) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets the description for a Shell link object. The description can be any
' application-defined string.
' ========================================================================================
FUNCTION IShellLink_SetDescription (BYVAL pthis AS DWORD PTR, BYREF pszName AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[7] USING IShellLink_SetDescription (pthis, pszName) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves the name of the working directory for a Shell link object.
' ========================================================================================
FUNCTION IShellLink_GetWorkingDirectory (BYVAL pthis AS DWORD PTR, BYREF pszDir AS ASCIIZ, BYVAL cch AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[8] USING IShellLink_GetWorkingDirectory (pthis, pszDir, cch) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets the name of the working directory for a Shell link object.
' ========================================================================================
FUNCTION IShellLink_SetWorkingDirectory (BYVAL pthis AS DWORD PTR, BYREF pszDir AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[9] USING IShellLink_SetWorkingDirectory (pthis, pszDir) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves the command-line arguments associated with a Shell link object.
' ========================================================================================
FUNCTION IShellLink_GetArguments (BYVAL pthis AS DWORD PTR, BYREF pszArgs AS ASCIIZ, BYVAL cch AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[10] USING IShellLink_GetArguments (pthis, pszArgs, cch) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets the command-line arguments for a Shell link object.
' ========================================================================================
FUNCTION IShellLink_SetArguments (BYVAL pthis AS DWORD PTR, BYREF pszArgs AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[11] USING IShellLink_SetArguments (pthis, pszArgs) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves the hot key for a Shell link object.
' ========================================================================================
FUNCTION IShellLink_GetHotKey (BYVAL pthis AS DWORD PTR, BYREF pwHotkey AS WORD) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[12] USING IShellLink_GetHotKey (pthis, pwHotkey) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets a hot key for a Shell link object.
' To set Ctrl+Alt+D as the hot key make a word as follows:
'   DIM wHotKey AS WORD
'   wHotKey = MAKWRD(ASC("D"), %HOTKEYF_CONTROL OR %HOTKEYF_ALT)
' ========================================================================================
FUNCTION IShellLink_SetHotKey (BYVAL pthis AS DWORD PTR, BYVAL pwHotkey AS WORD) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[13] USING IShellLink_SetHotKey (pthis, pwHotkey) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves the show command for a Shell link object.
' ========================================================================================
FUNCTION IShellLink_GetShowCmd (BYVAL pthis AS DWORD PTR, BYREF piShowCmd AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[14] USING IShellLink_GetShowCmd (pthis, piShowCmd) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets the show command for a Shell link object. The show command sets the initial show
' state of the window.
' ========================================================================================
FUNCTION IShellLink_SetShowCmd (BYVAL pthis AS DWORD PTR, BYVAL iShowCmd AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[15] USING IShellLink_SetShowCmd (pthis, iShowCmd) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves the location (path and index) of the icon for a Shell link object.
' ========================================================================================
FUNCTION IShellLink_GetIconLocation (BYVAL pthis AS DWORD PTR, BYREF pszIconPath AS ASCIIZ, BYVAL cch AS LONG, BYREF piIcon AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[16] USING IShellLink_GetIconLocation (pthis, pszIconPath, cch, piIcon) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets the location (path and index) of the icon for a Shell link object.
' ========================================================================================
FUNCTION IShellLink_SetIconLocation (BYVAL pthis AS DWORD PTR, BYREF pszIconPath AS ASCIIZ, BYVAL iIcon AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[17] USING IShellLink_SetIconLocation (pthis, pszIconPath, iIcon) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets the relative path to the Shell link object.
' ========================================================================================
FUNCTION IShellLink_SetRelativePath (BYVAL pthis AS DWORD PTR, BYREF pszPathRel AS ASCIIZ, OPTIONAL BYVAL dwReserved AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[18] USING IShellLink_SetRelativePath (pthis, pszPathRel, dwReserved) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Attempts to find the target of a Shell link, even if it has been moved or renamed.
' ========================================================================================
FUNCTION IShellLink_Resolve (BYVAL pthis AS DWORD PTR, BYVAL hwnd AS DWORD, BYVAL fFlags AS DWORD) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[19] USING IShellLink_Resolve (pthis, hwnd, fFlags) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets the path and file name of a Shell link object.
' ========================================================================================
FUNCTION IShellLink_SetPath (BYVAL pthis AS DWORD PTR, BYREF pszFile AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  IF pthis = %NULL THEN FUNCTION = %E_POINTER : EXIT FUNCTION
  CALL DWORD @@pthis[20] USING IShellLink_SetPath (pthis, pszFile) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' ========================================================================================

    ------------------
    Website: http://com.it-berater.org
    SED Editor, TypeLib Browser, COM Wrappers.
    Forum: http://www.forum.it-berater.org

    Leave a comment:

  • Peter Redei
    replied
    ' Little enhancement (added icon)
    Code:
    #DIM ALL
#COMPILE EXE
#INCLUDE "Win32Api.inc"

' =======================================================================================
' Constants
' =======================================================================================
%CLSCTX_INPROC_SERVER = &H1    ' Component is allowed in the same process space.
' =======================================================================================

' =======================================================================================
' IIDs
' =======================================================================================
$CLSID_ShellLink = GUID$("{00021401-0000-0000-C000-000000000046}")
$IID_IShellLink = GUID$("{000214EE-0000-0000-C000-000000000046}")
$IID_IPersistFile = GUID$("{0000010B-0000-0000-C000-000000000046}")
' =======================================================================================

' =======================================================================================
' Returns a pointer to a specified interface on an object to which a client currently
' holds an interface pointer.
' =======================================================================================
FUNCTION IUnknown_QueryInterface (BYVAL pthis AS DWORD PTR, BYREF riid AS GUID, BYREF ppvObj AS DWORD) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[0] USING IUnknown_QueryInterface (pthis, riid, ppvObj) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Decrements the reference count for the calling interface on a object. If the reference
' count on the object falls to 0, the object is freed from memory.
' =======================================================================================
FUNCTION IUnknown_Release (BYVAL pthis AS DWORD PTR) AS DWORD
  LOCAL DWRESULT AS DWORD
  CALL DWORD @@pthis[2] USING IUnknown_Release (pthis) TO   DWRESULT
  FUNCTION = DWRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the description string for a Shell link object.
' =======================================================================================
FUNCTION IShellLink_SetDescription (BYVAL pthis AS DWORD PTR, BYREF pszName AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[7] USING IShellLink_SetDescription (pthis, pszName) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the name of the working directory for a Shell link object.
' =======================================================================================
FUNCTION IShellLink_SetWorkingDirectory (BYVAL pthis AS DWORD PTR, BYREF pszDir AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[9] USING IShellLink_SetWorkingDirectory (pthis, pszDir) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the command-line arguments for a Shell link object.
' =======================================================================================
FUNCTION IShellLink_SetArguments (BYVAL pthis AS DWORD PTR, BYREF pszArgs AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[11] USING IShellLink_SetArguments (pthis, pszArgs) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the show command for a Shell link object. The show command sets the initial show
' state of the window.
' =======================================================================================
FUNCTION IShellLink_SetShowCmd (BYVAL pthis AS DWORD PTR, BYVAL iShowCmd AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[15] USING IShellLink_SetShowCmd (pthis, iShowCmd) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the path and file name of a Shell link object.
' =======================================================================================
FUNCTION IShellLink_SetPath (BYVAL pthis AS DWORD PTR, BYREF pszFile AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[20] USING IShellLink_SetPath (pthis, pszFile) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION

' =======================================================================================
' Sets the path to the icon.
' =======================================================================================
FUNCTION IShellLink_SetIconLocation (BYVAL pthis AS DWORD PTR, BYREF pszFile AS ASCIIZ, BYVAL iIndex AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[20] USING IShellLink_SetIconLocation (pthis, pszFile, iIndex) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Saves the object into the specified file.
' =======================================================================================
DECLARE FUNCTION Proto_IPersistFile_Save (BYVAL pthis AS DWORD PTR, BYVAL pszFileName AS DWORD, BYVAL fRemember AS LONG) AS LONG
' =======================================================================================
FUNCTION IPersistFile_Save (BYVAL pthis AS DWORD PTR, BYVAL strFileName AS STRING, BYVAL fRemember AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  LOCAL pszFileName AS DWORD
  IF LEN(strFileName) THEN
     strFileName = UCODE$(strFileName) & $NUL
     pszFileName = STRPTR(strFileName)
  END IF
  CALL DWORD @@pthis[6] USING Proto_IPersistFile_Save (pthis, pszFileName, fRemember) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Creates a shortcut
' =======================================================================================
FUNCTION CreateLink ( _
   BYVAL csidl AS LONG _         ' // Value specifying the folder for which to retrieve the location.
 , szLinkName AS ASCIIZ _        ' // Name of the shortcut
 , szExePath AS ASCIIZ _         ' // Path of the executable file
 , szArguments AS ASCIIZ _       ' // Arguments
 , szWorkingDir AS ASCIIZ _      ' // Working directory
 , BYVAL nShowCmd AS DWORD _     ' // Show command flag
 , szComment AS ASCIIZ _         ' // Comment
 , sIconPath AS ASCIIZ _         ' // Path to the icon file (if the file has an ison pass "")
 , lIconIndex AS LONG _          ' // Icon index (pass 0)
 ) AS LONG

   LOCAL hr AS LONG                         ' // HRESULT
   LOCAL psl AS DWORD                       ' // IShellLink interface reference
   LOCAL ppf AS DWORD                       ' // IPersistFile interrace reference
   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 pidl AS DWORD                      ' // Item identifier list specifying the folder location
   LOCAL szFileName AS ASCIIZ * %MAX_PATH   ' // Name of the .LNK file

   ' // Fills the guids
   CLSID_ShellLink = $CLSID_ShellLink
   IID_IShellLink = $IID_IShellLink
   IID_IPersistFile = $IID_IPersistFile

   ' // Creates an instance of the IShellLink interface
   hr = CoCreateInstance(CLSID_ShellLink, BYVAL %NULL, %CLSCTX_INPROC_SERVER, IID_IShellLink, psl)
   IF hr <> %S_OK THEN EXIT FUNCTION

   ' // Sets the properties of the shortcut
   hr = IShellLink_SetPath(psl, szExePath)
   hr = IShellLink_SetArguments(psl, szArguments)
   hr = IShellLink_SetWorkingDirectory(psl, szWorkingDir)
   hr = IShellLink_SetShowCmd(psl, nShowCmd)
   hr = IShellLink_SetDescription(psl, szComment)
   hr = IShellLink_SetIconLocation(psl,sIconPath, lIconIndex)
   
   ' // Retrieves a pointer to the IPersistFile interface
   hr = IUnknown_QueryInterface(psl, IID_IPersistFile, ppf)
   IF hr = %S_OK THEN
      ' // Retrieves an item identifier list specifying the desktop folder location
      hr = SHGetSpecialFolderLocation(%HWND_DESKTOP, csidl, pidl)
      IF hr = %NOERROR THEN
         ' // Retrieves the path from the item identifier list
         hr = SHGetPathFromIDList(BYVAL pidl, szFileName)
         ' // Frees the memory allocated for the item identifier list
         CoTaskMemFree pidl
         IF ISTRUE(hr) THEN
            ' // Full path
            szFileName = szFileName & "\" & szLinkName & ".LNK"
            ' // Saves the shortcut file
            hr = IPersistFile_Save(ppf, szFileName, %TRUE)
         END IF
         FUNCTION = %TRUE
      END IF
      ' // Releases the IPersistFile interface
      IUnknown_Release ppf
   END IF

   ' // Releases the IShellLink interface
   IUnknown_Release psl

END FUNCTION
' =======================================================================================

' =======================================================================================
' Main
' =======================================================================================
FUNCTION PBMAIN

   LOCAL hr AS LONG
   LOCAL sIconPath AS ASCIIZ * %MAX_PATH
   sIconPath = "C:\Program Files\Microsoft Visual Studio\Common\Graphics\Icons\Misc\CLOCK04.ICO" '<--- Change to your location
   
   hr = CreateLink(%CSIDL_DESKTOP, "PB shortcut", CURDIR$ & "\shelllink.exe", _
                       "My Arguments", CURDIR$, %SW_MAXIMIZE, "My comment", sIconPath, 0)
   IF ISTRUE (hr)THEN
      MSGBOX "See Desktop"
   ELSE
      MSGBOX "CreateLink failed"
   END IF

END FUNCTION
    ------------------

    Leave a comment:

  • Douglas C. Horner
    replied
    José

    Thank you very much for the code update! works like a charm

    Doug

    ------------------
    There is a principle which is a bar against all information, which is proof against all arguments and which cannot fail to keep a man in everlasting ignorance - that principle is contempt prior to investigation.

    Herbert Spencer

    Leave a comment:

  • José Roca
    replied
    for a discussion about how to set an hot key for the shortcut, see:
    http://www.powerbasic.com/support/pb...ad.php?t=12983

    Leave a comment:

  • José Roca
    replied
    Updated version of Semen's code to work with PBWin 8.x and the latest
    include files. I have commented the code and wrapped the low-level COM
    calls to make it easier to understand.
    Code:
    #DIM ALL
#COMPILE EXE
#INCLUDE "Win32Api.inc"

' =======================================================================================
' Constants
' =======================================================================================
%CLSCTX_INPROC_SERVER = &H1    ' Component is allowed in the same process space.
' =======================================================================================

' =======================================================================================
' IIDs
' =======================================================================================
$CLSID_ShellLink = GUID$("{00021401-0000-0000-C000-000000000046}")
$IID_IShellLink = GUID$("{000214EE-0000-0000-C000-000000000046}")
$IID_IPersistFile = GUID$("{0000010B-0000-0000-C000-000000000046}")
' =======================================================================================

' =======================================================================================
' Returns a pointer to a specified interface on an object to which a client currently
' holds an interface pointer. 
' =======================================================================================
FUNCTION IUnknown_QueryInterface (BYVAL pthis AS DWORD PTR, BYREF riid AS GUID, BYREF ppvObj AS DWORD) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[0] USING IUnknown_QueryInterface (pthis, riid, ppvObj) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Decrements the reference count for the calling interface on a object. If the reference
' count on the object falls to 0, the object is freed from memory.
' =======================================================================================
FUNCTION IUnknown_Release (BYVAL pthis AS DWORD PTR) AS DWORD
  LOCAL DWRESULT AS DWORD
  CALL DWORD @@pthis[2] USING IUnknown_Release (pthis) TO   DWRESULT
  FUNCTION = DWRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the description string for a Shell link object.
' =======================================================================================
FUNCTION IShellLink_SetDescription (BYVAL pthis AS DWORD PTR, BYREF pszName AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[7] USING IShellLink_SetDescription (pthis, pszName) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the name of the working directory for a Shell link object.
' =======================================================================================
FUNCTION IShellLink_SetWorkingDirectory (BYVAL pthis AS DWORD PTR, BYREF pszDir AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[9] USING IShellLink_SetWorkingDirectory (pthis, pszDir) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the command-line arguments for a Shell link object.
' =======================================================================================
FUNCTION IShellLink_SetArguments (BYVAL pthis AS DWORD PTR, BYREF pszArgs AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[11] USING IShellLink_SetArguments (pthis, pszArgs) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the show command for a Shell link object. The show command sets the initial show
' state of the window.
' =======================================================================================
FUNCTION IShellLink_SetShowCmd (BYVAL pthis AS DWORD PTR, BYVAL iShowCmd AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[15] USING IShellLink_SetShowCmd (pthis, iShowCmd) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the path and file name of a Shell link object.
' =======================================================================================
FUNCTION IShellLink_SetPath (BYVAL pthis AS DWORD PTR, BYREF pszFile AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[20] USING IShellLink_SetPath (pthis, pszFile) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Saves the object into the specified file.
' =======================================================================================
DECLARE FUNCTION Proto_IPersistFile_Save (BYVAL pthis AS DWORD PTR, BYVAL pszFileName AS DWORD, BYVAL fRemember AS LONG) AS LONG
' =======================================================================================
FUNCTION IPersistFile_Save (BYVAL pthis AS DWORD PTR, BYVAL strFileName AS STRING, BYVAL fRemember AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  LOCAL pszFileName AS DWORD
  IF LEN(strFileName) THEN
     strFileName = UCODE$(strFileName) & $NUL
     pszFileName = STRPTR(strFileName)
  END IF
  CALL DWORD @@pthis[6] USING Proto_IPersistFile_Save (pthis, pszFileName, fRemember) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Creates a shortcut
' =======================================================================================
FUNCTION CreateLink ( _
   BYVAL csidl AS LONG _         ' // Value specifying the folder for which to retrieve the location. 
 , szLinkName AS ASCIIZ _        ' // Name of the shortcut
 , szExePath AS ASCIIZ _         ' // Path of the executable file
 , szArguments AS ASCIIZ _       ' // Arguments
 , szWorkingDir AS ASCIIZ _      ' // Working directory
 , BYVAL nShowCmd AS DWORD _     ' // Show command flag
 , szComment AS ASCIIZ _         ' // Comment
 ) AS LONG

   LOCAL hr AS LONG                         ' // HRESULT
   LOCAL psl AS DWORD                       ' // IShellLink interface reference
   LOCAL ppf AS DWORD                       ' // IPersistFile interrace reference
   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 pidl AS DWORD                      ' // Item identifier list specifying the folder location
   LOCAL szFileName AS ASCIIZ * %MAX_PATH   ' // Name of the .LNK file

   ' // Fills the guids
   CLSID_ShellLink = $CLSID_ShellLink
   IID_IShellLink = $IID_IShellLink
   IID_IPersistFile = $IID_IPersistFile

   ' // Creates an instance of the IShellLink interface
   hr = CoCreateInstance(CLSID_ShellLink, BYVAL %NULL, %CLSCTX_INPROC_SERVER, IID_IShellLink, psl)
   IF hr <> %S_OK THEN EXIT FUNCTION
   
   ' // Sets the properties of the shortcut
   hr = IShellLink_SetPath(psl, szExePath)
   hr = IShellLink_SetArguments(psl, szArguments)
   hr = IShellLink_SetWorkingDirectory(psl, szWorkingDir)
   hr = IShellLink_SetShowCmd(psl, nShowCmd)
   hr = IShellLink_SetDescription(psl, szComment)

   ' // Retrieves a pointer to the IPersistFile interface
   hr = IUnknown_QueryInterface(psl, IID_IPersistFile, ppf)
   IF hr = %S_OK THEN
      ' // Retrieves an item identifier list specifying the desktop folder location
      hr = SHGetSpecialFolderLocation(%HWND_DESKTOP, csidl, pidl)
      IF hr = %NOERROR THEN
         ' // Retrieves the path from the item identifier list
         hr = SHGetPathFromIDList(BYVAL pidl, szFileName)
         ' // Frees the memory allocated for the item identifier list
         CoTaskMemFree pidl
         IF ISTRUE(hr) THEN
            ' // Full path
            szFileName = szFileName & "\" & szLinkName & ".LNK"
            ' // Saves the shortcut file
            hr = IPersistFile_Save(ppf, szFileName, %TRUE)
         END IF
         FUNCTION = %TRUE
      END IF
      ' // Releases the IPersistFile interface
      IUnknown_Release ppf
   END IF
   
   ' // Releases the IShellLink interface
   IUnknown_Release psl

END FUNCTION
' =======================================================================================

' =======================================================================================
' Main
' =======================================================================================
FUNCTION PBMAIN

   LOCAL hr AS LONG
   hr = CreateLink(%CSIDL_DESKTOP, "PB shortcut", CURDIR$ & "\shelllink.exe", _
                       "My Arguments", CURDIR$, %SW_MAXIMIZE, "My comment")
   IF ISTRUE (hr)THEN
      MSGBOX "See Desktop"
   ELSE
      MSGBOX "CreateLink failed"
   END IF

END FUNCTION
' =======================================================================================

    ------------------
    Website: http://com.it-berater.org
    SED Editor, TypeLib Browser, Wrappers for ADO, DAO, ODBC, SQL-DMO, WebBrowser Control, MSHTML, HTML Editing, CDOEX, MSXML, WMI, MSAGENT, Flash Player, Task Scheduler, Accesibility, Structured Storage, WinHTTP, Microsoft ActiveX Controls (Data Binding, ADODC, Flex Grid, Hierarchical Flex Grid, Masked Edit Control, DataList, DataCombo, MAPI, INET, MCI, Winsock, Common Dialog, MSChart, Outlook View Control), and Microsoft Scripting Components.



    [This message has been edited by José Roca (edited January 31, 2006).]

    Leave a comment:

  • Alfonso Olivares Ramos
    replied
    thank you

    ------------------

    Leave a comment:

  • Lance Edmonds
    replied
    Please do not carry out general questions in this forum, it is for the posting of source code only. With the revised declaration of CoInitialize(), modify the code thus:
    Code:
    CoInitialize BYVAL %NULL
    ------------------
    Lance
    PowerBASIC Support
    mailto:[email protected][email protected]</A>

    Leave a comment:

  • Alfonso Olivares Ramos
    replied
    Dear friends of powerbasic i was trying to use this code but it's
    dificult to me, my problems started when i copy the code in PBWin7.00
    and i think it confused "GUID" with function then i repalce "GUID" with
    "myGUID" in "TYPE GUID" and where it uses as TDU(Type Definided by User)
    and compiled with PBDLL6 and downloaded the API file from http://www.powerbasic.com/files/pub/pbwin/win32api.zip
    well, next i have a compile error with the next declaration:

    DECLARE FUNCTION CoInitialize LIB "ole32.dll" ALIAS "CoInitialize" (BYVAL pvReserved AS DWORD) AS DWORD

    it alredy exists in win32api this way:

    DECLARE FUNCTION CoInitialize LIB "ole32.dll" ALIAS "CoInitialize" (pvReserved AS ANY) AS LONG

    then i comented first one and then next compiler error

    variable expected in:

    CoInitialize %Null

    help is important to make shortcuts in PBWin7.00

    ------------------

    Leave a comment:

  • Peter Stephensen
    Guest replied
    Semen --
    I would prefer to use the GUID - type. I have translated BaseTyps.h:
    Code:
    TYPE GUID
     Data1 AS LONG
     Data2 AS WORD
     Data3 AS WORD
     Data4(0 TO 7) AS BYTE
END TYPE
 
SUB DEFINE_GUID(guidName AS GUID, BYVAL l AS LONG, BYVAL w1 AS WORD, BYVAL w2 AS WORD, _
                BYVAL b1 AS BYTE, BYVAL b2 AS BYTE, BYVAL b3 AS BYTE, BYVAL b4 AS BYTE, _
                BYVAL b5 AS BYTE, BYVAL b6 AS BYTE, BYVAL b7 AS BYTE, BYVAL b8 AS BYTE)
 
    guidName.Data1    = l
    guidName.Data2    = w1
    guidName.Data3    = w2
    guidName.Data4(0) = b1
    guidName.Data4(1) = b2
    guidName.Data4(2) = b3
    guidName.Data4(3) = b4
    guidName.Data4(4) = b5
    guidName.Data4(5) = b6
    guidName.Data4(6) = b7
    guidName.Data4(7) = b8
 
END SUB
 
SUB DEFINE_OLEGUID(guidName AS GUID, BYVAL l AS LONG, BYVAL w1 AS WORD, BYVAL w2 AS WORD)
 
    DEFINE_GUID guidName, l, w1, w2, &HC0, 0, 0, 0, 0, 0, 0, &H46
 
END SUB
    Now your code liiks like this:
    Code:
       #COMPILE EXE
   #DIM ALL
   #REGISTER NONE
   #INCLUDE "Win32Api.Inc"
   #INCLUDE "basetyps.inc"
 
   DECLARE FUNCTION CoInitialize LIB "ole32.dll" ALIAS "CoInitialize" (BYVAL pvReserved AS DWORD) AS DWORD
 
   DECLARE FUNCTION CoCreateInstance LIB "ole32.dll" ALIAS "CoCreateInstance" _
      (rclsid AS GUID, BYVAL pUnkOuter AS ANY, BYVAL dwClsContext AS DWORD, _
      riid AS GUID, ppv AS DWORD) AS DWORD
 
   DECLARE SUB CoUninitialize LIB "ole32.dll" ALIAS "CoUninitialize"
   DECLARE SUB CoTaskMemFree LIB "ole32.dll" ALIAS "CoTaskMemFree" (pv AS DWORD)
 
   DECLARE FUNCTION Sub1 (p1 AS ANY) AS DWORD
   DECLARE FUNCTION Sub2 (p1 AS ANY, p2 AS ANY) AS DWORD
   DECLARE FUNCTION Sub3 (p1 AS ANY, p2 AS ANY, p3 AS ANY) AS DWORD
 
   SUB CreateLink (BYVAL CSIDL AS LONG, LnkName AS ASCIIZ, _
                  ExePath AS ASCIIZ, Arguments AS ASCIIZ, WorkDir AS ASCIIZ, _
                  BYVAL ShowCmd AS DWORD, Comment AS ASCIIZ)
 
      LOCAL TmpAsciiz AS ASCIIZ * %MAX_PATH, TmpWide AS ASCIIZ * (2 * %MAX_PATH)
      LOCAL psl AS DWORD PTR, ppf AS DWORD PTR, pp AS DWORD PTR, lResult AS DWORD
      LOCAL CLSID_ShellLink AS GUID, IID_IShellLink AS GUID, _
            CLSCTX_INPROC_SERVER AS DWORD, IID_Persist AS GUID
 
      DEFINE_OLEGUID CLSID_ShellLink, &H00021401, 0, 0
      DEFINE_OLEGUID IID_IShellLink,  &H000214EE, 0, 0
      DEFINE_OLEGUID IID_Persist,     &H0000010B, 0, 0
 
      CLSCTX_INPROC_SERVER = 1
 
      CoInitialize %Null
 
      IF ISFALSE(CoCreateInstance (CLSID_ShellLink, %Null, CLSCTX_INPROC_SERVER, IID_IShellLink, psl)) THEN
         pp = @psl + 80: CALL DWORD @pp USING Sub2 (BYVAL psl, ExePath)       '21
         pp = @psl + 44: CALL DWORD @pp USING Sub2 (BYVAL psl, Arguments)     '12
         pp = @psl + 36: CALL DWORD @pp USING Sub2 (BYVAL psl, WorkDir)       '10
         pp = @psl + 60: CALL DWORD @pp USING Sub2 (BYVAL psl, BYVAL ShowCmd) '16
         pp = @psl + 28: CALL DWORD @pp USING Sub2 (BYVAL psl, Comment)       '8
         pp = @psl: CALL DWORD @pp USING Sub3 (BYVAL psl, IID_Persist, ppf) TO lResult
         IF lResult = 0 THEN
            DIM pidl AS DWORD
            TmpAsciiz = CURDIR$
            IF ISFALSE(SHGetSpecialFolderLocation(BYVAL %HWND_DESKTOP, BYVAL CSIDL, BYVAL VARPTR(pidl))) THEN
               SHGetPathFromIDList BYVAL pidl, TmpAsciiz
               CoTaskMemFree BYVAL pidl
            END IF
            TmpAsciiz = TmpAsciiz + "\" + LnkName + ".Lnk"
            MultiByteToWideChar %CP_ACP, 0, TmpAsciiz, -1, TmpWide, %MAX_PATH
            pp = @ppf + 24: CALL DWORD @pp USING Sub3 (BYVAL ppf, TmpWide, BYVAL %True)
            pp = @ppf + 8: CALL DWORD @pp USING Sub1 (BYVAL ppf)
         END IF
         pp = @psl + 8: CALL DWORD @pp USING Sub1 (BYVAL psl)
      END IF
 
      CoUninitialize
   END SUB
 
   FUNCTION PBMAIN
 
      CreateLink %CSIDL_DESKTOP, "PB shortcut", "c:\pbdll60\bin\pbedit.Exe", _
         "My Arguments", "c:\pbdll60\bin", %SW_MAXIMIZE, "My comment"
      MSGBOX "See Desktop"
 
   END FUNCTION
    Regards
    Peter


    ------------------

    Leave a comment:

  • Semen Matusovski
    replied
    Peter --
    look objidl.h
    EXTERN_C const IID IID_IPersistFile;
    MIDL_INTERFACE("0000010b-0000-0000-C000-000000000046")
    IPersistFile : public IPersist


    ------------------

    Leave a comment:

  • Peter Stephensen
    Guest replied
    What is IID_Persist, and where did you find it?

    Regards
    Peter

    ------------------

    Leave a comment:

  • Peter Stephensen
    Guest replied
    I found it in shlguid.h

    Regards
    Peter

    ------------------

    Leave a comment:

  • Peter Stephensen
    Guest replied
    Semen --

    Where did you find the values of CLSID_ShellLink, IID_IShellLink and IID_Persist ?

    Regards
    Peter

    ------------------

    Leave a comment:

  • Semen Matusovski
    replied
    Chris --
    I use current release of INC files (last update - Dec, 1999)
    http://www.powerbasic.com/files/pub/pbwin/win32api.zip

    [This message has been edited by Semen Matusovski (edited May 03, 2000).]

    Leave a comment:

  • Chris Boss
    replied
    Semen;

    The declaration for SHGetSpecialFolderLocation is missing in the win32api.inc file that came with PB 6.0, so I get an error when I compile.

    Do you have the declaration ?

    ------------------

    Leave a comment:

  • Semen Matusovski
    started a topic CreateShortcut subroutine (COM)

    CreateShortcut subroutine (COM)

    Advantages of COM approach are obvious - it's possible to change any field (I took most popular only)
    Don't forget that in LnkName it's possible to use only letters, allowed for file names.
    Code:
       ' Based on Florent Heyworth's PB code and MSDN
   
   #Compile Exe
   #Dim All
   #Register None
   #Include "Win32Api.Inc"

   Declare Function CoInitialize Lib "ole32.dll" Alias "CoInitialize" _
      (ByVal pvReserved As Dword) As Dword
   Declare Function CoCreateInstance Lib "ole32.dll" Alias "CoCreateInstance" _
      (rclsid As String * 16, ByVal pUnkOuter As Any, ByVal dwClsContext As Dword, _
      riid As String * 16, ppv As Dword) As Dword
   Declare Sub CoUninitialize Lib "ole32.dll" Alias "CoUninitialize"
   Declare Sub CoTaskMemFree Lib "ole32.dll" Alias "CoTaskMemFree" (pv As Dword)
   Declare Function Sub1 (p1 As Any) As Dword
   Declare Function Sub2 (p1 As Any, p2 As Any) As Dword
   Declare Function Sub3 (p1 As Any, p2 As Any, p3 As Any) As Dword

   Sub CreateLink (ByVal CSIDL As Long, LnkName As Asciiz, _
                  ExePath As Asciiz, Arguments As Asciiz, WorkDir As Asciiz, _
                  ByVal ShowCmd As Dword, Comment As Asciiz)
      Local TmpAsciiz As Asciiz * %MAX_PATH, TmpWide As Asciiz * (2 * %MAX_PATH)
      Local psl As Dword Ptr, ppf As Dword Ptr, pp As Dword Ptr, lResult As Dword
      Local CLSID_ShellLink As String * 16, IID_IShellLink As String * 16, _
            CLSCTX_INPROC_SERVER As Dword, IID_Persist As String * 16
      CLSID_ShellLink = Mkl$(&H00021401) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
      IID_IShellLink  = Mkl$(&H000214EE) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
      IID_Persist     = Mkl$(&H0000010B) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
      CLSCTX_INPROC_SERVER = 1
      
      CoInitialize %Null
      If IsFalse(CoCreateInstance (CLSID_ShellLink, %Null, CLSCTX_INPROC_SERVER, IID_IShellLink, psl)) Then
         pp = @psl + 80: Call Dword @pp Using Sub2 (ByVal psl, ExePath)
         pp = @psl + 44: Call Dword @pp Using Sub2 (ByVal psl, Arguments)
         pp = @psl + 36: Call Dword @pp Using Sub2 (ByVal psl, WorkDir)
         pp = @psl + 60: Call Dword @pp Using Sub2 (ByVal psl, ByVal ShowCmd)
         pp = @psl + 28: Call Dword @pp Using Sub2 (ByVal psl, Comment)
         pp = @psl: Call Dword @pp Using Sub3 (ByVal psl, IID_Persist, ppf) To lResult
         If lResult = 0 Then
            Dim pidl As Dword
            TmpAsciiz = CurDir$
            If IsFalse(SHGetSpecialFolderLocation(ByVal %HWND_DESKTOP, ByVal CSIDL, ByVal VarPtr(pidl))) Then
               SHGetPathFromIDList ByVal pidl, TmpAsciiz
               CoTaskMemFree ByVal pidl
            End If
            TmpAsciiz = TmpAsciiz + "\" + LnkName + ".Lnk"
            MultiByteToWideChar %CP_ACP, 0, TmpAsciiz, -1, TmpWide, %MAX_PATH
            pp = @ppf + 24: Call Dword @pp Using Sub3 (ByVal ppf, TmpWide, ByVal %True)
            pp = @ppf + 8: Call Dword @pp Using Sub1 (ByVal ppf)
         End If
         pp = @psl + 8: Call Dword @pp Using Sub1 (ByVal psl)
      End If
      CoUninitialize
   End Sub

   Function PbMain
      CreateLink %CSIDL_DESKTOP, "PB shortcut", "D:\Ltr.00\Bas32\Ltr32.Exe", _
         "My Arguments", "D:\Ltr.00\Bas32", %SW_MAXIMIZE, "My comment"
      MsgBox "See Desktop"
   End Function
    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