Eksport af favoritter

Denne her virker med Internet Explore 6 og 7, har ikke testet med tidligere:

procedure EksportFavoritter(Sti, EksportFilNavn : string);
var
    Urlfil : TInifile;
  Eksportfil : TStringList;
  Beskrivelse, Url, Mappe : string;

procedure SearchDir(Path : string);
var
  sr: TSearchRec;
  fr : integer;
begin
    fr:=FindFirst(Path+'*.*', faAnyFile, sr);
    while fr=0 do
    begin
        if (sr.Attr and faDirectory>0) and (sr.name<>'.') and (sr.name<>'..') then
            SearchDir(Path+sr.Name+'\')
        else
            if ExtractFileExt(sr.Name)='.url' then
          begin
              Urlfil:=TInifile.Create(Path+sr.Name);
            Url:=Urlfil.ReadString('InternetShortcut','URL','');
            if Url<>'' then
            begin
                            Beskrivelse:=AnsiQuotedStr(ChangeFileExt(sr.Name,''),'"');
              Mappe:=AnsiQuotedStr(ExcludeTrailingPathDelimiter(ExtractRelativePath(Sti,Path)),'"');
                Eksportfil.Add(Beskrivelse+', '+AnsiQuotedStr(Url,'"')+', '+Mappe);
            end;
                      Urlfil.Free;
                    end;
        fr:=FindNext(sr);
    end;
    FindClose(sr);
end;

begin
    Sti:=IncludeTrailingPathDelimiter(Sti);
    Eksportfil:=TStringList.Create;
    SearchDir(Sti);
  Eksportfil.SaveToFile(EksportFilNavn);
  Eksportfil.Free;
end;


Kaldes således:
EksportFavoritter('C:\Documents and Settings\Tack\Foretrukne','c:\hk\fav.txt');

Husk at tilføje Inifiles til din uses

Ser rigtig godt ud, tak for hjælpen, smid et svar :)

ok

Kom lige til at sidde lidt med ovenstående stump kode - og gjorde den mere generel - foruden jeg indsatte try-finally; det er en af mine kode-kæpheste.

uses
  IniFiles, Registry;

procedure EksportFavoritter(const aRoot : string; aResult : TStrings);

  procedure SearchDir(const aRelPath : string; aResult : TStrings);
  var
    UrlFil : TInifile;
    sr: TSearchRec;
    fr : integer;
    Url : string;
  begin
    fr := FindFirst(aRelPath+'*.*', faAnyFile, sr);
    try
      while fr = 0 do
      begin
        if (sr.Attr and faDirectory > 0) and (sr.name<>'.') and (sr.name<>'..') then
          SearchDir(IncludeTrailingPathDelimiter(aRelPath+sr.Name),aResult)
        else if ExtractFileExt(sr.Name)='.url' then
        begin
          Urlfil := TInifile.Create(aRelPath+sr.Name);
          try
            // Beskrivelse, url, mappe
            Url := Urlfil.ReadString('InternetShortcut','URL','');
            if Url <> '' then
              aResult.Add(format('%s;%s;%s',
                                [AnsiQuotedStr(ChangeFileExt(sr.Name,''),'"'),
                                  AnsiQuotedStr(Url,'"'),
                                  AnsiQuotedStr(ExcludeTrailingPathDelimiter(ExtractRelativePath(aRoot,aRelPath)),'"')]));
          finally
            Urlfil.Free;
          end;
        end;
        fr:=FindNext(sr);
      end;
    finally
      FindClose(sr);
    end;
  end;

begin
  aResult.Clear;
  SearchDir(IncludeTrailingPathDelimiter(aRoot),aResult);
end;

procedure TfrmMain.btnSearchClick(Sender: TObject);
const
  FavoritesKey = 'favorites';
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if not Reg.OpenKeyReadOnly('\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders') then
      raise Exception.Create('Adressen til favorit-folderen blev ikke fundet');

    if Reg.KeyExists(FavoritesKey) then
      raise Exception.Create('Favorit-foldernøglen blev ikke fundet');

    EksportFavoritter(Reg.ReadString(FavoritesKey),lbData.Items);

  finally
    Reg.Free;
  end;
end;

(lbData er et TListView)

.. så kommer de andre browsere: Firebird, Opera m.v. oveni (Firebird har sine liggende i en HTML-fil i kataloget "C:\Documents and Settings\<user>\Application Data\Mozilla\Firefox\Profiles\xxxxxxx.default).