this slowpoke moves

Create Shortcut on Desktop

Das Setzen einer Desktop-Verknüpfung hat einige Voraussetzungen.

Sollte der folgende Code nicht richtig funktionieren, so müsst ihr das "admin.manifest" mit in das Projekt einbauen. 

uses ExtCtrls, ActiveX, ShlObj, ComObj

function GetDesktopFolder: string;
var
  PIDList: PItemIDList;
  Buffer: array [0..MAX_PATH-1] of Char;
begin
  Result := '';
  SHGetSpecialFolderLocation(Application.Handle, CSIDL_DESKTOP, PIDList);
  if Assigned(PIDList) then
    if SHGetPathFromIDList(PIDList, Buffer) then
      Result := Buffer;
end;

function CreateDesktopShellLink(const TargetName: string): Boolean;
var
  IObject: IUnknown;
  ISLink: IShellLink;
  IPFile: IPersistFile;
  PIDL: PItemIDList;
  LinkName: string;
  InFolder: array [0..MAX_PATH-1] of Char;
begin
  Result := False;

  IObject := CreateComObject(CLSID_ShellLink);
  ISLink := IObject as IShellLink;
  IPFile := IObject as IPersistFile;

  with ISLink do
  begin
    SetDescription('Description ...');
    SetPath(PChar(TargetName));
    SetWorkingDirectory(PChar(ExtractFilePath(TargetName)));
  end;

  SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL);
  SHGetPathFromIDList(PIDL, InFolder) ;

  LinkName := IncludeTrailingBackslash(GetDesktopFolder);
  LinkName := LinkName + ExtractFileName(TargetName) + '.lnk';

  if not FileExists(LinkName) then
    if IPFile.Save(PWideChar(LinkName), False) = S_OK then
      Result := True;
end;
Beispiel 1, funktioniert nicht auf allen Windows Versionen
procedure TForm1.Button1Click(Sender: TObject);
begin
  if CreateDesktopShellLink('C:\Windows\System32\notepad.exe') then
    MessageDlg('Verknüpfung angelegt', mtInformation, [mbOk], 0);
end;
Beispiel 2, funktioniert auf allen Versionen :
procedure TForm1.Button2Click(Sender: TObject);
var
  IObject : IUnknown;
  ISLink : IShellLink;
  IPFile : IPersistFile;
  PIDL : PItemIDList;
  InFolder : array[0..MAX_PATH] of Char;
  TargetName : String;
  LinkName : WideString;
begin
  // HIER DEN PFAD DER DATEI ANGEBEN; WELCHES VERKNÜPFT WERDEN SOLL
  TargetName := 'C:\Windows\System32\notepad.exe';
  IObject := CreateComObject(CLSID_ShellLink);
  ISLink := IObject as IShellLink;
  IPFile := IObject as IPersistFile;

  with ISLink do begin
    SetPath(pChar(TargetName));
    SetWorkingDirectory
    (pChar(ExtractFilePath(TargetName)));
  end;

  SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL);
  SHGetPathFromIDList(PIDL, InFolder);
  
  // HIER DEN NAMEN DER VERKNÜPFUNG ANGEBEN
  LinkName := InFolder + '\notepad.exe.lnk';

  IPFile.Save(PWChar(LinkName), false);
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate