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.
Code:
' 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
Code:
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 )
Code:
$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