Der beste Weg auf allen Windows-Versionen, einen Startmenüeintrag vorzunehmen oder zu entfernen, ist, den speziellen Pfad des Start Menü Ordners zu ermitteln. Der ist aber auf allen Versionen nicht identisch, deshalb muss über den Shell der virtuelle Ordner ermittelt und dem Link Creator übergeben werden.
So kann man sicher gehen, dass die Funktion auf allen Windows-Versionen erfolgreich ist.
uses ShlObj, ActiveX, ShellApi, ComObj, ComCtrls
//
function DeleteFile(const AFile: string): boolean;
var
sh: SHFileOpStruct;
begin
ZeroMemory(@sh, sizeof(sh));
with sh do
begin
Wnd := Application.Handle;
wFunc := fo_Delete;
pFrom := PChar(AFile +#0);
fFlags := fof_Silent or fof_NoConfirmation;
end;
result := SHFileOperation(sh) = 0;
end;
// Link Creator
procedure CreateLink(const PathObj, PathLink, Desc, Param: string);
var
IObject: IUnknown;
SLink: IShellLink;
PFile: IPersistFile;
begin
IObject:=CreateComObject(CLSID_ShellLink);
SLink:=IObject as IShellLink;
PFile:=IObject as IPersistFile;
with SLink do
begin
SetArguments(PChar(Param));
SetDescription(PChar(Desc));
SetPath(PChar(PathObj));
end;
PFile.Save(PWChar(WideString(PathLink)), FALSE);
end;
// Virtuellen Ordner ermitteln
function GetSpecialFolder(const AFolder: Integer): string;
var
ItemIDList: PItemIDList;
hPath: PChar;
ShellH: IMalloc;
begin
if SUCCEEDED(SHGetSpecialFolderLocation(Application.Handle, AFolder, ItemIDList)) then
begin
try
hPath:= StrAlloc(max_path);
try
if SHGetPathFromIDList (ItemIDList, hPath) then
Result:=hPath;
finally
StrDispose(hPath);
end;
finally
if SHGetMalloc(ShellH) = NOERROR then
ShellH.Free(ItemIDList);
end;
end
else
RaiseLastOSError;
end;
// Laden des Programs welches eingetragen werden soll.
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Text := GetSpecialFolder(CSIDL_STARTMENU) + '\';
end;
Eintrag für Datei oder Ordner :
procedure TForm1.Button1Click(Sender: TObject);
var
Dir: string;
begin
Screen.Cursor := crHourGlass;
if RadioButton2.Checked = true then begin
Dir := Edit1.Text + Edit3.Text;
if ForceDirectories(Dir) then begin
StatusBar1.Panels[0].Text := Dir + ' Create done.';
end;
CreateLink(Edit2.Text, Edit1.Text + Edit3.Text + '\' + ExtractFileName(Edit2.Text) + '.lnk','','');
end;
if RadioButton1.Checked = true then begin
CreateLink(Edit2.Text, Edit1.Text + ExtractFileName(Edit2.Text) + '.lnk','','');
StatusBar1.Panels[0].Text := ' Create Folder done.';
end;
Sleep(150);
Screen.Cursor := crDefault;
end;
Eintrag entfernen für Datei oder Ordner :
procedure TForm1.Button2Click(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
if RadioButton1.Checked = true then begin
DeleteFile(Edit1.Text + ExtractFileName(Edit2.Text) + '.lnk');
StatusBar1.Panels[0].Text := ' Remove File link done.';
end;
if RadioButton2.Checked = true then begin
DeleteFile(Edit1.Text + Edit3.Text);
StatusBar1.Panels[0].Text := ' Remove Folder link done.';
end;
Sleep(150);
Screen.Cursor := crDefault;
end;
Keine Kommentare:
Kommentar veröffentlichen