PureBoard

Verfasst: **01.08.2016 10:58**

Hallo. Da die "alte" Version von DarkDragon's GetShellLinkInfo mit PB5.50 nicht ohne Fehlermeldungen läuft,
habe ich diese für PB5.50 Unicode tauglich gemacht.

0.2 : .URL Verknüpfung hinzugefügt
0.1 : Änderung : >= 0 zu = #S_OK (Dank an _JON_)

Code: Alles auswählen

;: GetShellLinkInfo()
;: 
;: Auslesen von Desktop Verknuepfungen (Unicode)
;: Windows Only
;: 
;: Original : DarkDragon (PB - ASCII) 
;: => http://purebasic.fr/german/viewtopic.php?f=8&t=4156
;: 
;: PB 5.50  : Bisonte    (PB - Unicode)
;: => http://purebasic.fr/german/viewtopic.php?f=8&t=29764
;: ---------------------------------------------------------------------------
;: 0.2 - Url "Verknüpfung" hinzugefügt
;: 0.1 - >= geändert zu = #S_OK (netmaestro)

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
CompilerEndIf

Structure ShellLinkInfo
  IconIndex.l
  Target.s
  Description.s
  WorkingDirectory.s
  Arguments.s
  IconLocation.s
  Hotkey_VK.l
  Hotkey_MOD.l
EndStructure

DataSection
  CompilerIf Defined(CLSID_ShellLink, #PB_Label) = #False
    CLSID_ShellLink:
    ; 00021401-0000-0000-C000-000000000046
    Data.l $00021401
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  CompilerEndIf
  CompilerIf Defined(IID_IShellLinkW, #PB_Label) = #False
    IID_IShellLinkW: ; Unicode {000214F9-0000-0000-C000-000000000046}
    Data.l $000214F9
    Data.w $0000, $0000
    Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  CompilerEndIf
  CompilerIf Defined(IID_IPersistFile, #PB_Label) = #False
    IID_IPersistFile:
    ; 0000010b-0000-0000-C000-000000000046
    Data.l $0000010b
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  CompilerEndIf
EndDataSection

Procedure GetShellLinkInfo(ShellLink.s, *p.ShellLinkInfo)
  
  Protected Result = #False, HotKey.w = 0, BuffSize = (#MAX_PATH+1)*4
  Protected *Buffer, psl.IShellLinkW, ppf.IPersistFile, fHnd
  Protected Com.s = LCase(GetExtensionPart(ShellLink))
  
  Select Com
      
    Case "lnk"
      
      *Buffer = AllocateMemory(BuffSize)
      
      If *Buffer
        
        CoInitialize_(0)
        
        If CoCreateInstance_(?CLSID_ShellLink, 0, 1, ?IID_IShellLinkW, @psl) = #S_OK
          
          If psl\QueryInterface(?IID_IPersistFile, @ppf) = #S_OK
            
            If ppf\Load(ShellLink, 1) = #S_OK
              
              psl\GetPath(*Buffer, BuffSize, 0, 0)
              *p\Target = PeekS(*Buffer) : FillMemory(*Buffer, BuffSize, 0)
              
              psl\GetDescription(*Buffer, BuffSize)
              *p\Description = PeekS(*Buffer) : FillMemory(*Buffer, BuffSize, 0)
              
              psl\GetWorkingDirectory(*Buffer, BuffSize)
              *p\WorkingDirectory = PeekS(*Buffer) : FillMemory(*Buffer, BuffSize, 0)     
              
              psl\GetArguments(*Buffer, BuffSize)
              *p\Arguments = PeekS(*Buffer) : FillMemory(*Buffer, BuffSize, 0)
              
              psl\GetHotkey(@Hotkey)
              *p\Hotkey_VK  = PeekB(@Hotkey) ; LowByte
              *p\Hotkey_MOD = PeekB(@Hotkey + 1) ; HighByte
              
              psl\GetIconLocation(*Buffer, 1024, *p)
              *p\IconLocation = PeekS(*Buffer)
              If *p\IconLocation = ""
                *p\IconLocation = *p\Target
              EndIf
              
            EndIf
            
            ppf\Release() 
            
          EndIf
          
          psl\Release()
          
        EndIf
        
        CoUninitialize_()
        FreeMemory(*Buffer)
        Result = #True
        
      EndIf
      
    Case "url"
      
      fHnd = OpenPreferences(ShellLink, #PB_Preference_NoSpace)
      
      If fHnd
        PreferenceGroup("InternetShortcut")
        *p\IconIndex = ReadPreferenceLong("IconIndex", 0)
        *p\IconLocation = ReadPreferenceString("IconFile", "")
        *p\Target = ReadPreferenceString("URL", "")
        ClosePreferences()
        Result = #True
      EndIf

  EndSelect
  
  ProcedureReturn Result

EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  
  Define SLI.ShellLinkInfo
  
  GetShellLinkInfo("C:\Users\*****\Desktop\notepad++.lnk", @SLI) ; <- Pfad anpassen
  Debug "--------------------------------------------------------------"
  Debug SLI\Target
  Debug SLI\Description
  Debug SLI\WorkingDirectory
  Debug SLI\Arguments
  Debug SLI\IconLocation
  Debug SLI\IconIndex
  
CompilerEndIf

Verbesserungsvorschläge sind willkommen.

Suche : Desktop Verknüpfung Unicode Shortcut ShellLink auslesen ermitteln

Verfasst: **01.08.2016 11:18**

Also das mit dem " >= 0 " funktioniert nur unter x86 korrect.

Besser wäre es mit " & $80000000 = 0 " zu prüfen, ob das Ergebnis ein erfolgreiches HRESULT ist.

Verfasst: **01.08.2016 11:50**

Ah... war mir gar nicht bewußt. In anderen Beispielen haben andere auf = #S_OK geprüft. Habe das erstmal übernommen.
(Soll ja nicht komplett verwirren

)

Dazu habe ich noch .url Files, die ja auch als "Verknüpfungen" auf dem Desktop liegen können (z.B. zu Steam Spielen) zum auslesen
hinzugefügt, wobei hier dann nur die Url als Target (was zum starten per RunProgram() reicht) und die IconLocation mit Index
geholt werden. (Mehr infos rückt das File ja nicht raus....)

Verfasst: **18.03.2022 10:24**

Wenn ich unter Windows 11 ohne Adminrechte auf die Verknüpfungen für alle Anwender (c:\ProgramData\Microsoft\Windows\Start Menu\Programs\) zugreifen will, steigt die Procedure bei

Code: Alles auswählen

If ppf\Load(ShellLink, 1) = #S_OK

aus.

Um den Zugriff zu erhalten muss die Zeile in

Code: Alles auswählen

If ppf\Load(ShellLink, 0) = #S_OK

geändert werden.

PureBoard

GetShellLinkInfo für PB5.50

GetShellLinkInfo für PB5.50

Re: GetShellLinkInfo für PB5.50

Re: GetShellLinkInfo für PB5.50

Re: GetShellLinkInfo für PB5.50