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
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • 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

  • #2
    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 ?

    ------------------
    Chris Boss
    Computer Workshop
    Developer of "EZGUI"
    http://cwsof.com
    http://twitter.com/EZGUIProGuy

    Comment


    • #3
      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).]

      Comment


      • #4
        Semen --

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

        Regards
        Peter

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

        Comment


        • #5
          I found it in shlguid.h

          Regards
          Peter

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

          Comment


          • #6
            What is IID_Persist, and where did you find it?

            Regards
            Peter

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

            Comment


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


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

              Comment


              • #8
                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


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

                Comment


                • #9
                  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

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

                  Comment


                  • #10
                    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]erbasic.com</A>
                    Lance
                    mailto:[email protected]

                    Comment


                    • #11
                      thank you

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

                      Comment


                      • #12
                        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).]
                        Forum: http://www.jose.it-berater.org/smfforum/index.php

                        Comment


                        • #13
                          for a discussion about how to set an hot key for the shortcut, see:
                          http://www.powerbasic.com/support/pb...ad.php?t=12983
                          Forum: http://www.jose.it-berater.org/smfforum/index.php

                          Comment


                          • #14
                            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
                            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

                            Comment


                            • #15
                              ' 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
                              ------------------

                              Comment


                              • #16
                                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
                                Forum: http://www.jose.it-berater.org/smfforum/index.php

                                Comment

                                Working...
                                X