Erstellen eines Shortcuts / Links

[Luckie]

Moin Daniel,

ich hab' s noch mal überarbeitet:

Delphi-Quellcode:

// 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;

Wie Mathias so richtig sagte, die Unit ACTIVEX muss noch mit eingebunden werden, sowie SHLOBJ.
Ich hoffe, dass ich jetzt nicht vergessen habe irgendetwas freizugeben, aber so funktioniert's
Eingestellt ist All Users, sollte es mal der Current User sein sollen, musst Du CSIDL_COMMON_DESKTOPDIRECTORY durch CSIDL_DESKTOPDIRECTORY austauschen.
SHGetSpecialFolderPath funktioniert unter NT 4 und Win 95 ab IE 4.0, ansonsten muss man sich mal nach einer anderen Variante umsehen diesen Pfad zu ermitteln.
Wichtig
Bei userspezifischer Installation kann man nicht den Namen des angemeldeten Users als Teil des Pfades annehmen, da bei eventueller Umbenennung des Accounts der Profilpfad nicht geändert wird, sondern noch den alten Namen enthält.

Das CoInitialize und CoUninitialize muss einmal pro Thread durchgeführt werden, sollte also sinnvoller Weise in der Projektdatei, oder der Unit des Hauptformulares stehen.

***EDIT***
Ich hab' die doppelte Initialisierung :oops: von wszShortCut mal gelöscht.
Der Test unter D6PE war auch erfolgreich, nur zu Deiner Beruhigung.

***EDIT, die zweite***
Das löschen geht dann schlicht mit DeleteFile. Den Pfad zu der Link Datei zu ermitteln dürfte jetzt wohl nicht die Schwierigkeit sein.

Autor: Christian Seehase

[edit=Matze][code] durch [delphi]-Tags ersetzt. Mfg, Matze[/edit]