Italia
Fonte/ Codesnippets

Anlegen Createlinkfile File Erstellen Link Lnk Shortcut Verknüpfung

 

' PRFellow-Vorlage
' Autor: Thomas Hölzer - Alle Rechte vorbehalten
' IShellLink-Interface und IPersistFile-Interface
' Hier: Link-Files anlegen
' Benötigt Profan 7.0
' Die Fehlerbehandlung wurde der besseren Panoramica
' wegen mit Return-Sprüngen implementiert
' Im Fehlerfall wird -1 zurückgegeben,
' bei Erfolg den OLE-Konventionen entsprechend 0 (= NO_ERROR)
' Die Parameter per CreateLinkFile sind genau(!) einzuhalten:
' 1: Name mit Pfad der gewünschten Linkdatei (*.lnk)
' 2: Dateiname mit Pfad, der verlinkt werden soll
' 3: Arbeitsverzeichnis oder Leerstring
' 3: Start-Parameter oder Leerstring
' 4: Optional: Pfad der File, die das anzuzeigende Icon enthält oder Leerstring
' 5: Nullbasierter Index des gewünschten Icons
' 6: HotKey-Wert oder 0
' Weitere Aiuto: Suchwort IShellLink in OLE32.HLP
' oder im MSDN https://msdn.microsoft.com/default.asp
' Bei Cerca beachten: IShellLink schreibt sich mit 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)
Declare CLSID_ShellLink$
CLSID_ShellLink$ = "{00021401-0000-0000-C000-000000000046}"
Declare SID_IShellLinkA$
SID_IShellLinkA$= "{000214EE-0000-0000-C000-000000000046}"
Declare IPersistFile$
IPersistFile$="{0000010B-0000-0000-C000-000000000046}"
Declare olestr#,clsid#,iid#
Declare pshellink#,ppersistfile#,ipersistfile#
Declare pislmethods#,pipfmethods#

Proc CleanupIShL

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

EndProc

Proc CreateLinkFile

    Parameters linkfile$,file$,workdir$,params$,icofile$,icoidx&,hotkey&
    Declare result%
    ' COM initialisieren
    CaseNot Succeeded(CoInitialize(0)): Return -1
    Dim olestr#,261' muß per IPersistFile so grande sein (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 und IID per IShellLink holen
    Clear olestr#
    MultiByteToWideChar(1,1,Addr(CLSID_ShellLink$),Len(CLSID_ShellLink$),olestr#,261)

    IfNot Succeeded(CLSIDFromString(olestr#,CLSID#))

        CleanupIShL
        Return -1

    EndIf

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

    IfNot Succeeded(IIDFromString(olestr#,IID#))

        CleanupIShL
        Return -1

    EndIf

    ' COM-Objekt erzeugen und Zeiger auf IShellLink-Methoden-Tabelle

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

        CleanupIShL
        Return -1

    EndIf

    Let pislmethods# =Long(pshellink#,0)
    ' ClassID per IPersistFile holen
    Clear olestr#
    MultiByteToWideChar(1,1,Addr(IPersistFile$),Len(IPersistFile$),olestr#,261)

    IfNot Succeeded(IIDFromString(olestr#,ppersistfile#))

        CleanupIShL
        Return -1

    EndIf

    ' QueryInterface: IPersistFile-Zeiger holen und Zeiger auf Methoden

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

        CleanupIShL
        Return -1

    EndIf

    pipfmethods#=Long(ipersistfile#,0)
    ' Dateiname der Linkdatei in WideString konvertieren
    Clear olestr#

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

        Len(LinkFile$))
        CleanupIShL
        Return -1

    EndIf

    ' Das IShellLink-Methoden aufrufen
    '.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
    Return Not(result%)

EndProc

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

If Equ(%(0),0)

    Print "OK"

Else

    Print "Fehler"

EndIf

WaitInput
 
02.09.2010  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

5.230 Views

Untitledvor 0 min.
R.Schneider20.05.2024
Jürgen Strahl16.04.2022
Walter14.03.2020
Uwe Lang17.12.2018
Di più...

Themeninformationen

Dieses Thema hat 1 subscriber:

iF (1x)


Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie