Internet - salvar os favoritos numa memo (com a url)

Top  Previous  Next

// coloca numa memo os favoritos

 

uses ARotinasUnit, ARotinas2Unit;

 

procedure SubDirSearch(var Lista: TStringList; Mascara: string; IncluirPasta: Boolean = True);

  procedure GetAllFiles(const Mask: string);

  var

    Search: TSearchRec;

    Verz  : string;

    Such  : string;

  begin

    Such := ExtractFileName( Mask );

    Verz := IncludeTrailingPathDelimiter(ExtractFilePath( Mask ));

 

    if FindFirst(Mask, $23, Search) = 0 then // All files

    repeat

      if IncluirPasta then Lista.Add(Verz + Search.Name) else Lista.Add(Search.Name);

    until FindNext(Search) <> 0;

 

    // Subdirectories

    if FindFirst(Verz + '*.*', faDirectory, Search) = 0 then

    repeat

      if ((Search.Attr and faDirectory) = faDirectory) and (Search.Name[1] <> '.') then

        GetAllFiles(Verz + Search.Name + '\' + Such);

    until FindNext(Search) <> 0;

    FindClose(Search);

  end;

begin

  Screen.Cursor := crHourGlass;

  Lista.Clear;

  GetAllFiles( Mascara );

  Screen.Cursor := crDefault;

end;

 

procedure GetFavoritos(var Lista: TStringList);

var

  Buffer: array[0..2047of Char;

  s: string;

  I: Integer;

  ListPasta: TStringList;

begin

  ListPasta:= TStringList.Create;

  Lista.Clear;

  S := LerReg('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders''Favorites''');

  SubDirSearch(ListPasta, DirBarra(S) + '*.url');

  for I := 0 to ListPasta.Count - 1 do

  begin

    GetPrivateProfileString('InternetShortcut''URL', nil, Buffer, SizeOf(Buffer), PChar(ListPasta[I]));

    S := Buffer;

    Lista.Add(ChangeFileExt(ExtractFileName(ListPasta[I]), '') + '¿' + S);

  end;    // for

  ListPasta.Free;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

var

  L: TStringList;

begin

  L := TStringList.Create;

  GetFavoritos(L);

  Memo1.Lines := L;

  L.Free;

end;