// Der Einfachheit halber heisst der Link genauso, wie die Datei
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
// 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
slShellLink.SetWorkingDirectory(PChar(ExtractFilePath(pcsFileToLinkTo)));
slShellLink.SetHotKey((MOD_WIN
shl 8)
or ord('
T'));
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
try
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
finally
FreeMem(wsShortCut,MAX_PATH
shl 1);
// und den Platz wieder freigeben
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Opendialog1.Execute
then
begin
NewShellLink(OpenDialog1.FileName);
end;
end;
initialization
begin
CoInitialize(
nil);
end;
finalization
begin
CoUnInitialize;
end;