Wie kann ich Programmgruppen und Shortcuts erzeugen?

Im folgenden sind die drei Funktionen CreateFolder, CreateLink und SpecialFolder definiert.

Erstellen eines normalen (!) Ordners:

  CreateFolder(<Name>);

<Name> : Komplette Pfadangabe

Beispiel zum Erstellen einer Programmgruppe 'Neu' im Ordner Programme (oder 'Program Files'):

  CreateFolder(SpecialDirectory(CSIDL_Programs)+'Neu');

  CreateLink(<Dateiname>,<Shortcutname>,<Shortcuttitel>);

<Dateiname> : Datei, auf die der Shortcut verweisen soll
<Shortcutname> : Dateiname des Shortcuts (mit Endung .lnk)
<Shortcuttitel> : Beschreibung des Shortcuts

Beispiel zum erstellt eines Links mit dem Titel "Programm" auf die Datei "C:\Test\Programm.exe" in der Autostart-Gruppe:

  CreateLink('C:\Test\Programm.exe',SpecialDirectory(CSIDL_Startup)+'Programm.lnk','tolles Programm');

  SpecialDirectory(<ID>);

<ID> : Identifier für Systemordner, mögliche Werte:

• Autostart-Gruppe : CSIDL_Startup
• Startmenü : CSIDL_Startmenu
• Programs-Menü : CSIDL_Programs
• Persönliche Favoriten : CSIDL_Favorites
• Desktop : CSIDL_Desktopdirectory
• "Send an"-Verzeichnis : CSIDL_Sendto

{$IFDEF VER90}
uses OLE2, ComObj, ShlObj;
{$ELSE}
uses ActiveX, ComObj, ShlObj;
{$ENDIF}

const IID_IPersistFile : TGUID=(D1:$0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));

function SpecialDirectory(ID:integer):string;
var pidl : PItemIDList;
    Path : PChar;
begin
  if SUCCEEDED(SHGetSpecialFolderLocation(0,ID,pidl)) then begin
    Path := StrAlloc(max_path);
    SHGetPathFromIDList(pidl,Path);
    Result := String(Path);
    if Result[length(Result)]<>'\' then
      Result := Result+'\';
  end;
end;

function CreateFolder(Foldername:string):boolean;
begin
  SetLastError(0);
  CreateDirectory(PChar(Foldername), nil );
  Result := (GetLastError()=0) or (GetLastError()=ERROR_ALREADY_EXISTS);
end;

function CreateLink(lpszPathObj,lpszPathLink,lpszDesc:string):Boolean;
var psl : IShellLink;
    ppf : IPersistFile;
begin
  Result := false;
  if SUCCEEDED(CoCreateInstance(CLSID_ShellLink,nil,CLSCTX_INPROC_SERVER, IID_IShellLinkA, psl)) then begin
    psl.SetPath(PChar(lpszPathObj));
    psl.SetDescription(PChar(lpszDesc));
    if SUCCEEDED(psl.QueryInterface(IID_IPersistFile,ppf)) then begin
      ppf.Save(StringToOLEStr(lpszPathLink),TRUE);
      Result := true;
    end;
  end;
end;

siehe auch:

Delphi FAQ