Avatar billede michaelthomassen Nybegynder
28. april 2007 - 18:34 Der er 4 kommentarer og
1 løsning

Eksport af favoritter

Jeg har brug for en funktion der eksporterer alle links der er gemt på ens computer, dvs. alle filer der ligger i "C:\Documents and Settings\<current user>\Favorites" (eller hvor de nu ligger på pågældende maskine) og undermapper hertil.

Eksport formatet skal være en tekstfil indholdende følgende: "beskrivelse", "url", "mappe", f.eks.:
"Eksperten", "http://www.eksperten.dk", ""
"Ekstrabladet", "http://www.eb.dk", "Nyheder\Danmark"
"NY Times", "http://www.nytimes.com", "Nyheder\USA"
"The Internet Movie Database", "http://www.imdb.com", "Film"

200 point til den der kan lave en fuld funktionel funktion ud fra det specificerede.
Avatar billede kroning Nybegynder
28. april 2007 - 21:11 #1
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');
Avatar billede kroning Nybegynder
28. april 2007 - 21:12 #2
Husk at tilføje Inifiles til din uses
Avatar billede michaelthomassen Nybegynder
29. april 2007 - 00:36 #3
Ser rigtig godt ud, tak for hjælpen, smid et svar :)
Avatar billede kroning Nybegynder
29. april 2007 - 09:39 #4
ok
Avatar billede hrc Mester
29. april 2007 - 22:47 #5
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).
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester