PBWin/PBCC IShellLink interface - create shortcuts

[Edwin Knoppert]

Here is another variant of the previous IShellLink code and allows you to set an icon.
The icon can be in any file and starts with offset 0
I did not modify it to a real interface for use with the latest PB compilers.

 

' Might be required for some PB versions:
' Remove if already exist in win32api.inc
'Declare Function CoInitialize Lib "ole32.dll" Alias "CoInitialize"( ByVal pvRerved As Dword ) As Dword
'Declare Sub CoUninitialize Lib "ole32.dll" Alias "CoUninitialize"
'Declare Function CoCreateInstance Lib "ole32.dll" Alias "CoCreateInstance" (rcsid As String * 16 _
', ByVal pUnkOuter As Any, ByVal dwClsContext As Dword, riid As String * 16, ppv As Dword) As Dword
 
 
' Prototypes
Declare Function IShellLink_Call0( ByVal pUnk As Long ) As Long
Declare Function IShellLink_Call1( ByVal pUnk As Long, ByVal p1 As Long ) As Long
Declare Function IShellLink_Call2( ByVal pUnk As Long, ByVal p1 As Long, ByVal p2 As Long ) As Long
 
'sTargetLinkName,   the link file to be created like c:\windows\desktop\myfile.lnk
'sSourceFileName,   the file/document where the shortcut should point to like c:\windows\calc.exe.
'sArguments,        commandline parameters
'sWorkDir,          The folder where the executable document/file should start in, best not to leave empty.
'nShowCmd,          %SW_SHOW, %SW_HIDE e.o.
'sComment,          Any comment, (does not appear in properties dialog for some reason but is stored though)
 
Function IShell_CreateLink( _
      ByVal sTargetLinkName As String _
    , ByVal sSourceFileName As String _
    , ByVal sArguments      As String _
    , ByVal sWorkDir        As String _
    , ByVal nShowCmd        As Long _
    , ByVal sIconFile       As String _
    , ByVal nIconIndex      As Long _
    , ByVal sComment        As String _
    ) As Long
 
    Local CLSID_ShellLink As String * 16
    Local IID_IShellLink  As String * 16
    Local IID_Persist     As String * 16
    Local nResult         As Long
    Local pShellLnk       As Dword Ptr
    Local pPersist        As Dword Ptr
 
    ' IShellLink interface
    ' IID = 000214EE-0000-0000-C000-000000000046
    ' Inherited interface = IUnknown

    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 )
    sTargetLinkName = UCode$( sTargetLinkName )
    
    Call CoInitialize( ByVal 0& )
 
    If CoCreateInstance( ByVal VarPtr( CLSID_ShellLink ), ByVal 0&, 1, ByVal VarPtr( IID_IShellLink ), pShellLnk ) = 0 Then
 
        ' IShellLink::SetPath
        Call Dword @@pShellLnk[20] Using IShellLink_Call1( pShellLnk, StrPtr( sSourceFileName ) )
        ' IShellLink::SetsArguments
        Call Dword @@pShellLnk[11] Using IShellLink_Call1( pShellLnk, StrPtr( sArguments ) )
        ' IShellLink::SetWorkingDirectory
        Call Dword @@pShellLnk[9] Using IShellLink_Call1( pShellLnk, StrPtr( sWorkDir ) )
        ' IShellLink::SetnShowCmd
        Call Dword @@pShellLnk[15] Using IShellLink_Call1( pShellLnk, nShowCmd )
        ' IShellLink::SetDescription
        Call Dword @@pShellLnk[7] Using IShellLink_Call1( pShellLnk, StrPtr( sComment ) )
        ' Obtain persist interface (QueryInterface)
        Call Dword @@pShellLnk[0] Using IShellLink_Call2( pShellLnk, VarPtr( IID_Persist ), VarPtr( pPersist ) )
         ' IShellLink::SetIconLocation
        Call Dword @@pShellLnk[17] Using IShellLink_Call2( pShellLnk, StrPtr( sIconFile ), 0 )

        If nResult = 0 Then 
            ' Convert to unicode
            ' IPersistFile::Save
            Call Dword @@pPersist[6] Using IShellLink_Call2( pPersist, StrPtr( sTargetLinkName ), 1 )
            ' Release
            Call Dword @@pPersist[2] Using IShellLink_Call0( pPersist )
 
        End If
 
        ' Release
        Call Dword @@pShellLnk[2] Using IShellLink_Call0( pShellLnk )
 
        Function = -1
 
    End If
 
    Call CoUninitialize()
 
End Function

Example:

   Local a As Long
 
    a = IShell_CreateLink( _
        "C:\Documents and Settings\Edwin Knoppert\Bureaublad\mycalc.lnk" _
        , "c:\windows\system32\calc.exe" _
        , "" _
        , "c:\windows" _
        , %SW_SHOW _
        , "c:\windows\system32\packager.exe" _
        , 0 _
        , "No sComments!" )

    MsgBox Str$( a )

For info: here is the interface code (which is not used in this example)

$IID_IShellLink = Guid$("{000214EE-0000-0000-C000-000000000046}")

Interface IShellLink $IID_IShellLink: Inherit IUnknown

   Method GetPath( ByRef Asciiz, ByVal Long, ByRef WIN32_FIND_DATA, ByVal Dword ) As Long   
   Method GetIDList( ByRef Dword ) As Long
   Method SetIDList( ByVal Dword ) As Long
   Method GetDescription( ByRef Asciiz, ByVal Long ) As Long
   Method SetDescription( ByRef Asciiz ) As Long
   Method GetWorkingDirectory( ByRef Asciiz, ByVal Long ) As Long
   Method SetWorkingDirectory( ByRef Asciiz ) As Long
   Method GetArguments( ByRef Asciiz, ByVal Long ) As Long
   Method SetArguments( ByRef Asciiz ) As Long
   Method GetHotkey( ByRef Word ) As Long
   Method SetHotkey( ByVal Word ) As Long
   Method GetShowCmd( ByRef Long ) As Long
   Method SetShowCmd( ByVal Long ) As Long
   Method GetIconLocation( ByRef Asciiz, ByVal Long, ByRef Long ) As Long
   Method SetIconLocation( ByRef Asciiz, ByVal Long ) As Long
   Method SetRelativePath( ByRef Asciiz, ByVal Dword ) As Long
   Method Resolve( ByVal Dword, ByVal Dword ) As Long   
   Method SetPath( ByRef Asciiz ) As Long   

End Interface