Seite 1 von 1

CreateShortcut für PB 4 und >

Verfasst: 27.05.2006 17:01
von ts-soft

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

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.IShellLinkA, ppf.IPersistFile, mem.s, hres.l, Result.l
  If IconFile = "|" : IconFile = Path : EndIf
  If Not WorkingDir : WorkingDir = GetPathPart(Path) : EndIf
  CoInitialize_(0)
  If CoCreateInstance_(?CLSID_ShellLink,0,1,?IID_IShellLink,@psl) = 0
    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) = 0
      mem.s = Space(1000)
      MultiByteToWideChar_(#CP_ACP, 0, Link, -1, mem, 1000)
      hres = ppf\Save(@mem,#True)
      Result = 1
      ppf\Release()
    EndIf
    psl\Release()
  EndIf
  CoUninitialize_()
  ProcedureReturn Result
  DataSection
    CLSID_ShellLink:
    Data.l $00021401
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
    IID_IShellLink:
    Data.l $000214EE
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
    IID_IPersistFile:
    Data.l $0000010B
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  EndDataSection
EndProcedure

Verfasst: 04.09.2007 19:56
von nco2k
was muss man ändern, damit es auch unter unicode funktioniert?

edit: hat sich erledigt. hab die notwendigen infos im englischen forum gefunden.

Code: Alles auswählen

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 ppf.IPersistFile, mem.s, hres.l, Result.l
  CompilerIf #PB_Compiler_Unicode
    Protected psl.IShellLinkW
  CompilerElse
    Protected psl.IShellLinkA
  CompilerEndIf
  If IconFile = "|" : IconFile = Path : EndIf
  If Not WorkingDir : WorkingDir = GetPathPart(Path) : EndIf
  CoInitialize_(0)
  If CoCreateInstance_(?CLSID_ShellLink,0,1,?IID_IShellLink,@psl) = 0
    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) = 0
      CompilerIf #PB_Compiler_Unicode
        hres = ppf\Save(@Link, #True)
      CompilerElse
        mem = Space(1000)
        MultiByteToWideChar_(#CP_ACP, 0, Link, -1, mem, 1000)
        hres = ppf\Save(@mem,#True)
      CompilerEndIf
      If hres = 0
        Result = 1
      EndIf
      ppf\Release()
    EndIf
    psl\Release()
  EndIf
  CoUninitialize_()
  ProcedureReturn Result
  DataSection
    CLSID_ShellLink:
    Data.l $00021401
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
    IID_IShellLink:
    CompilerIf #PB_Compiler_Unicode
      Data.l $000214F9
    CompilerElse
      Data.l $000214EE
    CompilerEndIf
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
    IID_IPersistFile:
    Data.l $0000010B
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  EndDataSection
EndProcedure
dank geht an Rescator.

c ya,
nco2k

Re: CreateShortcut für PB 4 und >

Verfasst: 12.04.2010 14:47
von ts-soft
Update für PB 4.50 (Unicode und ASCII-Support)

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


Re: CreateShortcut für PB 4 und >

Verfasst: 29.05.2010 09:01
von horst
ts-soft hat geschrieben:Update für PB 4.50 (Unicode und ASCII-Support)
Ich suche eine unter PB 4.50 lauffähige Version von ShortcutTarget(), wie z.B. hier:
http://www.purebasic.fr/german/viewtopi ... 37#p271237

Leider ist es mir eine Anpassung nicht gelungen, wobei ich gemerkt habe, dass in der Struktur IID_IShellLinkA noch die Funktion GetPath() falsch definiert ist. Weiß aber nicht, ob diese Funktion hier gebraucht wird...

Re: CreateShortcut für PB 4 und >

Verfasst: 06.03.2016 16:21
von Axolotl
Ich hatte gerade diese Funktion gesucht, da sie unter Windows 10 und unicode nicht lief, habe ich ein paar Änderungen gemacht.

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 ;}

;' Testcode ...
Define file.s = "irgendwas, was auf .lnk endet!"
Debug "File= '"+ShortcutTarget(file)
Sorry, wenn ich den alten Faden wieder aktiviere....
LG Andreas

Re: CreateShortcut für PB 4 und >

Verfasst: 26.05.2016 12:48
von Sicro

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.