// Der Einfachheit halber heisst der Link genauso, wie die Datei
function CreateDesktopLink(const p_sFilePath : string;const p_sDesktopDir : string) : Boolean;
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
wszShortCut : PWideChar; // Buffer für den Shortcutnamen
hRes : HResult; // Für Zwischenergebnisse
sShortCut : string; // So heisst dann der Shortcut
dwLen : DWORD;
begin
Result := false;
//
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); // Pointer auf IShellLink Interface
if hRes <> S_OK then
begin
exit;
end;
slShellLink.SetPath(PChar(p_sFilePath)); // Auf diese Datei geht der Link
hRes := slShellLink.QueryInterface(IID_IPersistFile,pfPersistFile); // Pointer auf IPersist holen
if hRes <> S_OK then
begin
exit;
end;
dwLen := (MAX_PATH+1)*2;
wszShortcut := AllocMem(dwLen);
try
sShortCut := ChangeFileExt(p_sFilePath,'.LNK');
sShortCut := p_sDesktopDir + '\' + ExtractFileName(sShortCut);
StringToWideChar(sShortCut,wszShortCut,dwLen);
hRes := pfPersistFile.Save(wszShortCut, TRUE); // Jetzt noch den Link speichern
finally
FreeMem(wszShortCut,dwLen); // und den Platz wieder freigeben
end;
Result := (hRes = S_OK);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
szDesktopFolder : PChar;
begin
if Opendialog1.Execute then
begin
szDesktopFolder := StrAlloc(MAX_PATH+1);
try
if not SHGetSpecialFolderPath(self.Handle,szDesktopFolder,CSIDL_COMMON_DESKTOPDIRECTORY,false) then
begin
ShowMessage(SysErrorMessage(GetLastError));
exit;
end;
if not CreateDesktopLink(OpenDialog1.FileName,szDesktopFolder) then
begin
ShowMessage(SysErrorMessage(GetLastError));
end;
finally
StrDispose(szDesktopFolder);
end;
end;
end;
initialization
begin
CoInitialize(nil);
end;
finalization
begin
CoUninitialize;
end;