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.
Link : admin.manifest
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