this slowpoke moves

Create Start Menu Entry

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

Beliebte Posts

Translate