posted July 10, 2003 05:26 AM            

#Compile Exe
 
Option Explicit
 
#Include "win32api.inc"
 
'--------------------------------------------------------------------------
 
'// 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 sComment        As String _
    ) As Long
 
    Dim CLSID_ShellLink As String * 16
    Dim IID_IShellLink  As String * 16
    Dim IID_Persist     As String * 16
    Dim nResult         As Long
    Dim pShellLnk       As Dword Ptr
    Dim pPersist        As Dword Ptr
    Dim szUniLnkName    As Asciiz * ( 2 * %MAX_PATH )
 
    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 )
 
    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 ) )
 
        If nResult = %S_OK Then
 
            '// Convert to unicode
            MultiByteToWideChar %CP_ACP, 0, ByVal StrPtr( sTargetLinkName ), Len( sTargetLinkName ), ByVal VarPtr( szUniLnkName ), %MAX_PATH * 2
 
            '// IPersistFile::Save
            Call Dword @@pPersist[6] Using IShellLink_Call2( pPersist, VarPtr( szUniLnkName ), 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
 
    CoUninitialize
 
End Function
 
'--------------------------------------------------------------------------
 
Function WinMain( ByVal hCurInstance  As Long, _
                  ByVal hPrevInstance As Long, _
                  lpszCmdLine         As Asciiz Ptr, _
                  ByVal nCmdShow      As Long ) As Long
 
    Dim a As Long
 
    a = IShell_CreateLink( "c:\windows\desktop\mycalc.lnk", "c:\windows\calc.exe", "", "c:\windows", %SW_SHOW, "No sComments!" )
    MsgBox Str$( a )
 
End Function

------------------
http://www.hellobasic.com