Eigenes Favoriten-Menü

[MathiasSimmack]

Also, hier eine Lösung mit zwei Wegen. Es geht nämlich auch ohne TIniFile, da der URL-Dateityp eigentlich im System bekannt ist. Wenn du aber auf Nummer Sicher gehen willst, machst du´s selbst:

Delphi-Quellcode:

{.$DEFINE TINIFILE}

procedure TForm1.OnURLMenuItemClick(Sender: TObject);
begin
  if(Sender is TMenuItem) and
    ((Sender as TMenuItem).Hint <> '') then
  ShellExecute(self.Handle,'open',pchar((Sender as TMenuItem).Hint),
    nil,nil,SW_SHOWNORMAL);
end;

procedure TForm1.LoadLocalFavorites;

  procedure scanit(const orgPath: string; parentMI: TMenuItem);
  var
    path : string;
    res  : integer;
    ds   : TSearchRec;
    mii  : TMenuItem;
{$IFDEF TINIFILE}
    ini  : TIniFile;
{$ENDIF}
  begin
    path := GetCurrentDir;

    // zuerst alle Ordner, weil das Einträge für
    // Untermenüs werden
    res := FindFirst('*.*',faAnyFile,ds);
    while(res = 0) do
    begin
      if(ds.Attr and faDirectory <> 0) and
        (ds.Attr and faHidden = 0) and
        ((ds.Name <> '.') and (ds.Name <> '..')) then
      begin
        mii         := TMenuItem.Create(parentMI);
        mii.Caption := ds.Name;

        // rein ins Menü
        parentMI.Add(mii);

        if(SetCurrentDir(ds.Name)) then
          scanit(orgPath,mii);
      end;

      res := FindNext(ds); Application.ProcessMessages;
    end;
    FindClose(ds);

    // und jetzt alle URL-Dateien suchen
    res := FindFirst('*.url',faAnyFile,ds);
    while(res = 0) do
    begin
      if(ds.Name <> '.') and
        (ds.Name <> '..') and
        (ds.Attr and faDirectory = 0) then
      begin
        mii            := TMenuItem.Create(parentMI);
        mii.Caption    := ChangeFileExt(ds.Name,'');

{$IFDEF TINIFILE}
        ini := TIniFile.Create(path + '\' + ds.Name);
        if(ini <> nil) then
        try
          mii.Hint := ini.ReadString('InternetShortcut','URL','');
        finally
          ini.Free;
        end;
{$ELSE}
        mii.Hint       := '"' + path + '\' + ds.Name + '"';
{$ENDIF}
        mii.ImageIndex := 11;
        mii.OnClick    := OnURLMenuItemClick;

        // ab ins Menü damit
        if(mii.Hint <> '') and
          (mii.Caption <> '') then parentMI.Add(mii);
      end;

      res := FindNext(ds); Application.ProcessMessages;
    end;
    FindClose(ds);

    // und wieder einen Ordner nach oben
    if(path <> orgPath) then ChDir('..');
  end;


var
  cDummy,
  xPath  : string;
begin
  // aktuelles Verzeichnis ermitteln
  cDummy := GetCurrentDir;

  // Favoritenordner des aktuellen Benutzers
  // ermitteln, ...
  xPath := GetSpecialFolder(CSIDL_FAVORITES);
  // ... & scannen
  if(xPath <> '') and
    (SetCurrentDir(xPath)) then scanit(xPath,mmFavoriten);

  // du kannst auch noch die Favoriten für
  // alle Benutzer anhängen, wenn du nach
  // "CSIDL_COMMON_FAVORITES" suchst
end;

Eine Funktion zum korrekten Ermitteln des Favoritenordners findest du hier im Forum. Der Eintrag im Hauptmenü der Form heißt bei mir mmFavoriten und dient als Parent für die gefundenen Ordner und URL-Dateien aus dem Favoriten-Verzeichnis.

Sorry, aber ich habe gleich noch gefuttert.