GetShellLinkInfo für PB5.50

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Bisonte
Beiträge: 2427
Registriert: 01.04.2007 20:18

GetShellLinkInfo für PB5.50

Beitrag von Bisonte »

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
Zuletzt geändert von Bisonte am 01.08.2016 11:46, insgesamt 1-mal geändert.
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
Benutzeravatar
_JON_
Beiträge: 389
Registriert: 30.03.2010 15:24

Re: GetShellLinkInfo für PB5.50

Beitrag von _JON_ »

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.
PureBasic 5.46 LTS (Windows x86/x64) | windows 10 x64 Oktober failure
Benutzeravatar
Bisonte
Beiträge: 2427
Registriert: 01.04.2007 20:18

Re: GetShellLinkInfo für PB5.50

Beitrag von Bisonte »

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....)
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
IB-Software
Beiträge: 57
Registriert: 29.08.2004 11:05
Computerausstattung: Windows 11
Wohnort: Berlin
Kontaktdaten:

Re: GetShellLinkInfo für PB5.50

Beitrag von IB-Software »

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.
PureBasic 5.73/6.04 Beta 2; Windows 11 Pro 64
Intel(R) Core(TM) i7-8700 CPU @ 3.20GHz 3.19 GHz 16GB; NVIDIA GeForce RTX 3060 16GB
Antworten