Procedure NewShellLink(Const pcsFileToLinkTo : String); // Auf diese Datei soll verwiesen werden
const // Fehlende Deklaration in Delphi
// Zu finden in der Registry
// HKEY_CLASSES_ROOT\Interface
// nach IPersistFile suchen
IID_IPersistFile: TGUID = '{0000010b-0000-0000-C000-000000000046}';
Var
slShellLink : IShellLink; // ShellLink Interface
pfPersistFile : IPersistFile; // Shortcut (Link) Permanent speichern
wsShortCut : PWideChar; // Buffer für den Shortcutnamen
hRes : HResult; // Für Zwischenergebnisse
sShortCut : String; // So heisst dann der Shortcut
Begin
CoInitialize(nil); //
COM Library Initialisieren (einmal pro Thread deshalb hier eigentlich
// Fehl am Platze :(
//
COM Object der Klasse ShellLink erzeugen
hRes := CoCreateInstance(CLSID_ShellLink, // ID von ShellLink (Typ TGUID)
nil,
CLSCTX_INPROC_SERVER,
IID_IShellLinkA, // Referenz auf die Funktion
slShellLink); // erhält nach erfolgreichem Aufruf
// den Pointer auf die Funktion
if hRes = S_OK then
Begin
slShellLink.SetPath(PChar(pcsFileToLinkTo)); // Auf diese Datei geht der Link
hRes := slShellLink.QueryInterface(IID_IPersistFile, // wieder mal einen
pfPersistFile); // Pointer holen
end;
if hRes = S_OK then
Begin
GetMem(wsShortCut,MAX_PATH shl 1); // Speicher reservieren für den Shortcutpfadnamen
// Eigentlich genügt die Länge MAX_PATH, aber da
// der Wert in
UNICode zurückgegeben wird mal 2
sShortCut := ChangeFileExt(pcsFileToLinkTo,'.LNK'); // Soll einfach mal so heissen,
// Wie die aufzurufende Datei
MultiByteToWideChar(CP_ACP, //
ANSI Codepage benutzen
0,
PChar(sShortCut), // Der soll konvertiert werden
-1, // der zu konvertierende String ist Null terminiert
wsShortCut, // und hier soll das Ergebnis rein
MAX_PATH shl 1); // Länge von wsShortCut
pfPersistFile.Save(wsShortCut, TRUE); // Jetzt noch den Link speichern
FreeMem(wsShortCut,MAX_PATH shl 1); // und den Platz wieder freigeben
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Opendialog1.Execute then
Begin
NewShellLink(OpenDialog1.FileName);
end;
end;