Code: Alles auswählen
; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=3078&highlight=
; Author: Danilo
; Date: 09. December 2003
;
; create shell links/shortcuts
; translated from my old example that used CallCOM()
;
; by Danilo, 09.12.2003
; changed for easy use in PB 4.0 >
; by ts-soft
; changed for PB 4.50 and Unicode
EnableExplicit
Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  CompilerIf Defined(Name, #PB_Variable)
    If SizeOf(Name) = SizeOf(GUID)
      Name\Data1    = l
      Name\Data2    = w1
      Name\Data3    = w2
      Name\Data4[0] = b1
      Name\Data4[1] = b2
      Name\Data4[2] = b3
      Name\Data4[3] = b4
      Name\Data4[4] = b5
      Name\Data4[5] = b6
      Name\Data4[6] = b7
      Name\Data4[7] = b8
    Else
      Debug "Error - variable not declared as guid"
    EndIf
  CompilerEndIf
EndMacro
Procedure CreateShortcut(Path.s, Link.s, WorkingDir.s = "", Argument.s = "", ShowCommand.l = #SW_SHOWNORMAL, Description.s =  "", HotKey.l = #Null, IconFile.s = "|", IconIndex.l = 0)
  Protected psl.IShellLinkW, ppf.IPersistFile, Result
  Protected.GUID CLSID_ShellLink, IID_IShellLink, IID_IPersistFile
  DEFINE_GUID(CLSID_ShellLink, $00021401, $0000,$0000, $C0, $00, $00, $00, $00, $00, $00, $46) ; {00021401-0000-0000-C000-000000000046}
  DEFINE_GUID(IID_IShellLink, $000214F9, $0000,$0000, $C0, $00, $00, $00, $00, $00, $00, $46)  ; {000214F9-0000-0000-C000-000000000046}
  DEFINE_GUID(IID_IPersistFile, $0000010B, $0000,$0000, $C0, $00, $00, $00, $00, $00, $00, $46); {0000010b-0000-0000-C000-000000000046}
  If IconFile = "|" : IconFile = Path : EndIf
  If Not WorkingDir : WorkingDir = GetPathPart(Path) : EndIf
  CoInitialize_(0)
  If CoCreateInstance_(@CLSID_ShellLink, 0, 1, @IID_IShellLink, @psl) =  #S_OK
    Set_ShellLink_preferences:
    psl\SetPath(Path)
    psl\SetArguments(Argument)
    psl\SetWorkingDirectory(WorkingDir)
    psl\SetDescription(DESCRIPTION)
    psl\SetShowCmd(ShowCommand)
    psl\SetHotkey(HotKey)
    psl\SetIconLocation(IconFile, IconIndex)
    ShellLink_SAVE:
    If psl\QueryInterface(@IID_IPersistFile, @ppf) = #S_OK
      ppf\Save(Link, #True)
      result = 1
      ppf\Release()
    EndIf
    psl\Release()
  EndIf
  CoUninitialize_()
  ProcedureReturn result
EndProcedure
Wird in 
CodeArchiv unter Files_and_Dirs/File/CreateShortcutFile[WIN].pbi aufgenommen.
Code: Alles auswählen
Procedure.s ShortcutTarget(ShortcutFile.s)
  Protected Result.s, *buffer
  If Right(LCase(ShortcutFile), 4) <> ".lnk"
    ProcedureReturn ShortcutFile
  EndIf
  CoInitialize_(0)
  Protected ShellLink.IShellLinkW  ;' A..W (unicode!)
  Protected LinkFile.IPersistFile
  If CoCreateInstance_(?CLSID_ShellLink, 0, 1, ?IID_IShellLink, @ShellLink) = #S_OK
    If ShellLink\QueryInterface(?IID_IPersistFile, @LinkFile) = #S_OK
      *buffer = AllocateMemory(1024)
      If *buffer
        If LinkFile\Load(ShortcutFile, 0) = #S_OK
          If ShellLink\Resolve(0, 1) = #S_OK
            ShellLink\GetPath(*buffer, 1024, 0, 0)
            Result = PeekS(*buffer)
          EndIf
        EndIf
        FreeMemory(*buffer)
      EndIf
      LinkFile\Release()
    EndIf
    ShellLink\Release()
  EndIf
  CoUninitialize_()
  ProcedureReturn Result
EndProcedure
DataSection ;{ CLSID_ShellLink, IID_IPersistFile, ...
  CLSID_ShellLink:
  ; 00021401-0000-0000-C000-000000000046
  Data.l $00021401
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  IID_IPersistFile:
  ; 0000010b-0000-0000-C000-000000000046
  Data.l $0000010B
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  CompilerIf #PB_Compiler_Unicode = 0
  IID_IShellLink:
  ; DEFINE_SHLGUID(IID_IShellLinkA, 0x000214EEL, 0, 0);
  ; C000-000000000046
  Data.l $000214EE
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  CompilerElse
  IID_IShellLink: ; {000214F9-0000-0000-C000-000000000046}
  Data.l $000214F9
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  CompilerEndIf
EndDataSection ;}
Wird in 
CodeArchiv unter Files_and_Dirs/File/ReadShortcutFile[WIN].pbi aufgenommen.