Composant tdbpfindfiles

Télécharger le projet
Commenter

Description

FindFiles trouve recursivement les dossiers et fichiers. Capable de rechercher par extensions, d'inclure le chemin des resultats, on peut aussi maximiser le nb de résultats. Compo très utile.

Source / Exemple : 


{
################################################################################
# DBPFINDFILES                                                                 #
################################################################################
#                                                                              #
# VERSION       : 0.6                                                          #
# FICHIERS      : dbpFindFiles.pas,.dcu,.dcr,.bmp,ReadMe.htm                   #
# AUTEUR        : Julio P. (Diabloporc)                                        #
# CREATION      : 22 fev 2004                                                  #
# MODIFIEE      : -                                                            #
# SITE WEB      : http://diabloporc.free.fr                                    #
# MAIL          : diabloporc@laposte.net                                       #
# LEGAL         : Free sous Licence GNU/GPL                                    #
# INFOS         : Retrouvez moi sur www.delphifr.com : "JulioDelphi"           #
#                 Lisez le ReadMe.htm !                                        #
#                                                                              #
################################################################################
}
unit dbpFindFiles;

{$R dbpFindFiles.dcr}

interface

uses
 Windows, SysUtils, Classes, StrMan, Forms, Dialogs, Controls;

type
 TFindType = (
                ftFichiers,
                ftDossiers,
                ftLesDeux
               );
 TFoundEvent = procedure(const OneMoreFileOrDir: string) of object;

 TdbpFindFiles = class(TComponent)
  private
    FTailleRechch:                           Double;
    FResultatFichiers,FResultatDossiers:     TStringList;
    FExtensions:                             TStrings;
    FChchParExtensions, FSousDossiers,
    FInclureChemin:                          Boolean;
    FOnTrouve:                               TFoundEvent;
    FFindType:                               TFindType;
    FNbResultatFichiers, FNbResultatDossiers,
    i, FMaxResultats:                        Integer;
    FDossier, FAbout:                        string;

    procedure FindFiles(Directory: string; MaxResultats: integer);
    procedure SetExtensions(const Extensions: TStrings);
    procedure SetDirectory(var Directory: string);
    procedure SetMaxResultats(Value: integer);
    procedure SetDossier(Value: string);
    procedure SetAbout(Value: string);
  public
    procedure   Execute;                                                overload;
    procedure   Execute(Directory: string; MaxResultats: integer);      overload;
    property    NbResultatFichiers: Integer     read FNbResultatFichiers;
    property    NbResultatDossiers: Integer     read FNbResultatDossiers;
    property    ResultatFichiers:   TStringList read FResultatFichiers;
    property    ResultatDossiers:   TStringList read FResultatDossiers;
    property    TailleRechch:       Double      read FTailleRechch;
    constructor Create(AOwner: TComponent);                             override;
    destructor  destroy;                                                override;
  published
    property About:             string          read FAbout             write SetAbout;
    property ChchParExtensions: Boolean         read FChchParExtensions write FChchParExtensions;
    property Dossier:           string          read FDossier           write setDossier;
    property Extensions:        TStrings        read FExtensions        write SetExtensions;
    property InclureCheminDansResult: Boolean   Read FInclureChemin     write FInclureChemin;
    property IncSousDossiers:   Boolean         read FSousDossiers      write FSousDossiers;
    property MaxResultats:      Integer         read FMaxResultats      write SetMaxResultats;
    property OnTrouve:          TFoundEvent     read FOnTrouve          write FOnTrouve;
    property FindType:          TFindType       read FFindType          write FFindType default ftFichiers;
  end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('Diabloporc', [TdbpFindFiles]);
end;

constructor TdbpFindFiles.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FResultatFichiers        := TStringList.Create;
  FResultatDossiers        := TStringList.Create;
  FResultatFichiers.Sorted := true;
  FResultatDossiers.Sorted := true;
  FExtensions              := TStringList.Create;
  i                        := 0;
  FMaxResultats            := 1000;
  FDossier                 := ExtractFilePath(application.exename);
  FInclureChemin           := true;
  FAbout                   := 'V0.6 par Julio P. (Diabloporc)';
end;

destructor TdbpFindFiles.destroy;
begin
  inherited Destroy;
  FResultatFichiers.Free;
  FResultatDossiers.Free;
  FExtensions.Free;
end;

procedure TdbpFindFiles.SetDirectory(var Directory: string);
begin
  if Length(Directory) = 1 then Directory := Directory + DriveDelim;
  if not (sm.LastChar(Directory) = PathDelim) then Directory := Directory + PathDelim;
end;

procedure TdbpFindFiles.FindFiles(Directory: string; MaxResultats: Integer);
var
  SearchRec: TSearchRec;
  OneMoreItem: string;
  oldCursor: TCursor;
begin
  SetDirectory(Directory);
  oldCursor := screen.Cursor;
  if FindFirst(Directory + '*.*', faAnyFile, SearchRec) = 0 then
   repeat
    Application.ProcessMessages;
    screen.Cursor:=crHourGlass;
    if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') and ((SearchRec.Attr and faHidden) <> 2) and ((SearchRec.Attr and faSysFile) <> 4) then
     begin
      if FInclureChemin then OneMoreItem := Directory + SearchRec.Name else OneMoreItem := SearchRec.Name;

      if (FFindType = ftDossiers) and ((SearchRec.Attr and faDirectory) <> 0) then
       begin
        if Assigned(FOnTrouve) then FOnTrouve(OneMoreItem);
        FResultatDossiers.Add(OneMoreItem+PathDeLim);
        inc(i);
       end
      else

       if FFindType = ftLesDeux then
        begin
         if Assigned(FOnTrouve) then FOnTrouve(OneMoreItem);
         if (SearchRec.Attr and faDirectory) <> 0 then
          begin
           FResultatDossiers.Add(OneMoreItem+PathDelim);
           inc(i);
          end
         else
          if (FExtensions.Count = 0) or ((FExtensions.IndexOf(ExtractFileExt(OneMoreItem)) <> -1) and FChchParExtensions) or ((FExtensions.IndexOf(ExtractFileExt(OneMoreItem)) = -1) and not FChchParExtensions) then
           begin
            if Assigned(FOnTrouve) then FOnTrouve(OneMoreItem);
            FResultatFichiers.Add(OneMoreItem);
            inc(i);
           end;
        end
       else

        if (FFindType = ftFichiers) and ((SearchRec.Attr and faDirectory) = 0) then
         begin
          if (FExtensions.Count = 0) or ((FExtensions.IndexOf(ExtractFileExt(OneMoreItem)) <> -1) and FChchParExtensions) or ((FExtensions.IndexOf(ExtractFileExt(OneMoreItem)) = -1) and not FChchParExtensions) then
           begin
            if Assigned(FOnTrouve) then FOnTrouve(OneMoreItem);
            FResultatFichiers.Add(OneMoreItem);
            inc(i);
           end;
         end;

        FTailleRechch := FTailleRechch + SearchRec.Size;
        FNbResultatDossiers := FResultatDossiers.Count;
        FNbResultatFichiers := FResultatFichiers.count;
        if (SearchRec.Attr and faDirectory <> 0) and (FSousDossiers) then
         begin
          if not FInclureChemin then
           FindFiles(Directory+OneMoreItem,MaxResultats)
          else
           FindFiles(OneMoreItem,MaxResultats);
          end;
         end;

   until (FindNext(SearchRec) <> 0) or (i>=MaxResultats+1);
   FindClose(SearchRec);
   screen.cursor := oldCursor;
end;

procedure TdbpFindFiles.SetExtensions(const Extensions: TStrings);
begin
  FExtensions.Assign(Extensions);
end;

procedure TdbpFindFiles.Execute(Directory: string; MaxResultats: Integer);
begin
  FResultatDossiers.Clear;
  FResultatFichiers.Clear;
  FTailleRechch := 0;
  i             := 0;
  FindFiles(Directory, MaxResultats);
end;

procedure TdbpFindFiles.Execute;
begin
  Execute(FDossier,FMaxResultats);
end;

procedure TdbpFindFiles.SetDossier(value: string);
begin
 if not sm.IsEmpty(Value) then FDossier := Value else MessageDlg('"Dossier" ne peut être vide.',mtError,[mbOk],0);
end;

procedure TdbpFindFiles.SetMaxResultats(value: integer);
begin
 if Value<=0 then Value := 1;
 FMaxResultats          := Value;
end;

procedure TdbpFindFiles.SetAbout(Value: string);
begin
//
end;
end.

Conclusion :


il existe des composants avec plus d'options mais bon :) j'aime bien le mien leger quand j'ai pas besoin de ces options justement :D
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (JulioDelphi)