XProfan

' PRFellow-Presentación
' Autor: Thomas Hölzer - Alle Rechte vorbehalten
' IShellLink-Interface y IPersistFile-Interface
' Hier: Link-Files invertir
' Benötigt Profano 7.0
' El Fehlerbehandlung wurde el mejor Información general
' wegen con Volver-Sprüngen implementiert
' Im Fehlerfall se -1 zurückgegeben,
' en Erfolg el OLE-Konventionen entsprechend 0 (= NO_ERROR)
' El Parámetro para CreateLinkFile son genau(!) einzuhalten:
' 1: Name con Pfad el deseado Linkdatei (*.lnk)
' 2: Dateiname con Pfad, el verlinkt voluntad se
' 3: Arbeitsverzeichnis oder Leerstring
' 3: Start-Parámetro oder Leerstring
' 4: Optional: Pfad el Expediente, el el anzuzeigende Icon enthält oder Leerstring
' 5: Nullbasierter Index des deseado Icons
' 6: HotKey-Valor oder 0
' Weitere Ayuda: Suchwort IShellLink en OLE32.HLP
' o MSDN https://msdn.microsoft.com/default.asp
' En Búsqueda beachten: IShellLink schreibt se con 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)
Declarar CLSID_ShellLink$
CLSID_ShellLink$ = "{00021401-0000-0000-C000-000000000046}"
Declarar SID_IShellLinkA$
SID_IShellLinkA$= "{000214EE-0000-0000-C000-000000000046}"
Declarar IPersistFile$
IPersistFile$="{0000010B-0000-0000-C000-000000000046}"
Declarar olestr#,clsid#,iid#
Declarar pshellink#,ppersistfile#,ipersistfile#
Declarar pislmethods#,pipfmethods#

Proc CleanupIShL

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

ENDPROC

Proc CreateLinkFile

    Parámetros linkfile$,file$,workdir$,params$,icofile$,icoidx&,hotkey&
    Declarar resultado%
    ' COM inicializar
    Casenote Succeeded(CoInitialize(0)): Volver -1
    Dim olestr#,261' muß para IPersistFile así groß ser (MAX_PATH+1)
    Dim clsid#,16
    Dim iid#,16
    Dim pshellink#,4
    Dim ipersistfile#,4
    Dim ppersistfile#,16
    Dim pislmethods#,84
    Dim pipfmethods#,36
    ' ClassID y IID para IShellLink holen
    Claro olestr#
    MultiByteToWideChar(1,1,Addr(CLSID_ShellLink$),Len(CLSID_ShellLink$),olestr#,261)

    Caso negativo Succeeded(CLSIDFromString(olestr#,CLSID#))

        CleanupIShL
        Volver -1

    EndIf

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

    Caso negativo Succeeded(IIDFromString(olestr#,IID#))

        CleanupIShL
        Volver -1

    EndIf

    ' COM-Objeto erzeugen y Zeiger en IShellLink-Métodos-Tabla

    Caso negativo Succeeded(CoCreateInstance(CLSID#,0,1,IID#,Addr(pshellink#)))

        CleanupIShL
        Volver -1

    EndIf

    Let pislmethods# =Largo(pshellink#,0)
    ' ClassID para IPersistFile holen
    Claro olestr#
    MultiByteToWideChar(1,1,Addr(IPersistFile$),Len(IPersistFile$),olestr#,261)

    Caso negativo Succeeded(IIDFromString(olestr#,ppersistfile#))

        CleanupIShL
        Volver -1

    EndIf

    ' QueryInterface: IPersistFile-Zeiger holen y Zeiger en Métodos

    Caso negativo Succeeded(Call(Largo(pislmethods#,0),pshellink#,ppersistfile#,Addr(ipersistfile#)))

        CleanupIShL
        Volver -1

    EndIf

    pipfmethods#=Largo(ipersistfile#,0)
    ' Dateiname el Linkdatei en WideString konvertieren
    Claro olestr#

    Caso negativo Equ(MultiByteToWideChar(1,1,Addr(linkfile$),Len(linkfile$),olestr#,261),

        Len(LinkFile$))
        CleanupIShL
        Volver -1

    EndIf

    ' Das IShellLink-Métodos aufrufen
    '.SetWorkDir
    Call(Largo(pislmethods#,36),pshellink#,Addr(workdir$))
    '.SetArguments
    Call(Largo(pislmethods#,44),pshellink#,Addr(params$))
    '.SetHotKey
    Call(Largo(pislmethods#,52),pshellink#,hotkey&)
    '.SetIconLocation
    Call(Largo(pislmethods#,68),pshellink#,Addr(icofile$),icoidx&)
    '.SetPath
    Call(Largo(pislmethods#,80),pshellink#,Addr(file$))
    ' IPersistFile.Save
    Call(Largo(pipfmethods#,24),ipersistfile#,olestr#,1)
    ' Aufräumen
    Call(Largo(pipfmethods#,8),ipersistfile#)
    resultado%=Succeeded(Call(Largo(pislmethods#,8),pshellink#))
    CleanupIShL
    Volver Not(resultado%)

ENDPROC

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

If Equ(%(0),0)

    Imprimir "OK"

Más

    Imprimir "Fehler"

EndIf

WaitInput