XProfan

' PRFellow-Présentation
' Autor: Thomas Bois - Alle Rechte vorbehalten
' IShellLink-Interface et IPersistFile-Interface
' ici: Link-Files anlegen
' Requiert Profan 7.0
' qui Fehlerbehandlung wurde qui besseren Vue d'ensemble
' à cause de avec Retour-Sprüngen implementiert
' Im Fehlerfall wird -1 retour,
' chez Erfolg den OLE-Konventionen entsprechend 0 (= NO_ERROR)
' qui paramètre pour CreateLinkFile sommes oui c'est ca(!) einzuhalten:
' 1: nom avec Pfad qui gewünschten Linkdatei (*.lnk)
' 2: Dateiname avec Pfad, qui verlinkt volonté soll
' 3: Arbeitsverzeichnis ou bien Leerstring
' 3: Start-paramètre ou bien Leerstring
' 4: optionnel: Pfad qui Dossier, qui cela anzuzeigende Icon contient ou bien Leerstring
' 5: Nullbasierter index des gewünschten Icônes
' 6: HotKey-Wert ou bien 0
' Weitere Aider: Suchwort IShellLink dans OLE32.HLP
' ou bien im MSDN https://msdn.microsoft.com/default.asp
' chez cherche tenir compte de: IShellLink écrit sich avec 3 L!
Def CoInitialize(1) !"OLE32","CoInitialize"
Def CoUnInitialize(0) !"OLE32","CoUninitialize"
Def CoCreateInstance(5) !"OLE32","CoCreateInstance"
Def CLSIDFromString(2) !"OLE32","CLSIDFromString"
Def IIDFromString(2) !"OLE32","IIDFromString"
Def MultiByteToWideChar(6) !"KERNEL32","MultiByteToWideChar"
Def WideCharToMultiByte(8) !"KERNEL32","WideCharToMultiByte"
Def Succeeded(1) Gt(&(1),-1)
Déclarer CLSID_ShellLink$
CLSID_ShellLink$ = "{00021401-0000-0000-C000-000000000046}"
Déclarer SID_IShellLinkA$
SID_IShellLinkA$= "{000214EE-0000-0000-C000-000000000046}"
Déclarer IPersistFile$
IPersistFile$="{0000010B-0000-0000-C000-000000000046}"
Déclarer olestr#,clsid#,iid#
Déclarer pshellink#,ppersistfile#,ipersistfile#
Déclarer pislmethods#,pipfmethods#

Proc CleanupIShL

    Dispose olestr#
    Dispose pislmethods#
    Dispose pipfmethods#
    Dispose ppersistfile#
    Dispose ipersistfile#
    Dispose pshellink#
    Dispose clsid#
    Dispose iid#
    CoUnInitialize()

ENDPROC

Proc CreateLinkFile

    Paramètres linkfile$,file$,workdir$,params$,icofile$,icoidx&,hotkey&
    Déclarer result%
    ' COM initialisieren
    Casenote Succeeded(CoInitialize(0)): Retour -1
    Faible olestr#,261' doit pour IPersistFile aussi grand son (MAX_PATH+1)
    Faible clsid#,16
    Faible iid#,16
    Faible pshellink#,4
    Faible ipersistfile#,4
    Faible ppersistfile#,16
    Faible pislmethods#,84
    Faible pipfmethods#,36
    ' ClassID et IID pour IShellLink holen
    Claire olestr#
    MultiByteToWideChar(1,1,Addr(CLSID_ShellLink$),Len(CLSID_ShellLink$),olestr#,261)

    Si non Succeeded(CLSIDFromString(olestr#,CLSID#))

        CleanupIShL
        Retour -1

    EndIf

    Claire olestr#
    MultiByteToWideChar(1,1,Addr(SID_IShellLinkA$),Len(SID_IShellLinkA$),olestr#,261)

    Si non Succeeded(IIDFromString(olestr#,IID#))

        CleanupIShL
        Retour -1

    EndIf

    ' COM-objet erzeugen et aiguille sur IShellLink-Methoden-Tabelle

    Si non Succeeded(CoCreateInstance(CLSID#,0,1,IID#,Addr(pshellink#)))

        CleanupIShL
        Retour -1

    EndIf

    Laisser pislmethods# =Long(pshellink#,0)
    ' ClassID pour IPersistFile holen
    Claire olestr#
    MultiByteToWideChar(1,1,Addr(IPersistFile$),Len(IPersistFile$),olestr#,261)

    Si non Succeeded(IIDFromString(olestr#,ppersistfile#))

        CleanupIShL
        Retour -1

    EndIf

    ' QueryInterface: IPersistFile-aiguille holen et aiguille sur Methoden

    Si non Succeeded(Call(Long(pislmethods#,0),pshellink#,ppersistfile#,Addr(ipersistfile#)))

        CleanupIShL
        Retour -1

    EndIf

    pipfmethods#=Long(ipersistfile#,0)
    ' Dateiname qui Linkdatei dans WideString konvertieren
    Claire olestr#

    Si non Equ(MultiByteToWideChar(1,1,Addr(linkfile$),Len(linkfile$),olestr#,261),

        Len(LinkFile$))
        CleanupIShL
        Retour -1

    EndIf

    ' cela IShellLink-Methoden appel
    '.SetWorkDir
    Call(Long(pislmethods#,36),pshellink#,Addr(workdir$))
    '.SetArguments
    Call(Long(pislmethods#,44),pshellink#,Addr(params$))
    '.SetHotKey
    Call(Long(pislmethods#,52),pshellink#,hotkey&)
    '.SetIconLocation
    Call(Long(pislmethods#,68),pshellink#,Addr(icofile$),icoidx&)
    '.SetPath
    Call(Long(pislmethods#,80),pshellink#,Addr(file$))
    ' IPersistFile.Save
    Call(Long(pipfmethods#,24),ipersistfile#,olestr#,1)
    ' Aufräumen
    Call(Long(pipfmethods#,8),ipersistfile#)
    result%=Succeeded(Call(Long(pislmethods#,8),pshellink#))
    CleanupIShL
    Retour Not(result%)

ENDPROC

' Beispiel
Cls
CreateLinkFile "C:PRFTEST.LNK",Ajouter$($WinPath,"EXPLORER.EXE"),"C",»,"SHELL32.DLL",41,0

Si Equ(%(0),0)

    Imprimer "OK"

D'autre

    Imprimer "Fehler"

EndIf

WaitInput