Composant tvuxfilescanner

Commenter

Contenu du snippet

Ce composant permet de parcourir une arborescence.
On peut spécifier:
-le filtre (*.*), etc...
-les attributs
-Si l' on parcourt les sous-répertoires

Note: j'ai modifie le zip marchait pas, je mets le code directement:

Source / Exemple : 


unit VUXFileScanner;
{
Composant TVUXFileScanner

Développé par:
VUX (vux@fr.st)

Composant non visuel permettant de parcourir une arborescence de
répertoires/sous répertoires.

Petit bug connu: Pour parcourir les sous répertoires, la propriété
filter doit être obligatoirement : "*.*"

Version actuelle: 1.0

Mises à jour:
}
interface

uses
  Windows, Messages, SysUtils, Classes,FileCtrl;

type
  TDataFoundEvent = procedure(Sender :Tobject;FileName:String;
                const Filedata:TSearchRec;var Stop: Boolean) of object;
{ Evenement utilisé lorsque l' on a trouvé un fichier.
  
  \-Filename : Nom du fichier
  
  \-FileData : Informations sur le fichier
  
  \-Stop : Si vous le passez à True, le Scan est interrompu. }

  TFileAttributes = class(Tpersistent)
  public
    FatReadOnly : Boolean;
    FatHidden : Boolean;
    FatSysFile : Boolean;
    FatVolumeID : Boolean;
    FatDirectory : Boolean;
    FatArchive : Boolean;
    FatAnyFile : Boolean;
  published
    property atReadOnly : Boolean read FatReadOnly write fatreadonly;
    property atHidden : Boolean read FatHidden write FatHidden;
    property atSysFile : Boolean read FatSysFile write FatSysFile;
    property atVolumeID : Boolean read FatVolumeID write FatVolumeID;
    property atDirectory : Boolean read FatDirectory write FatDirectory;
    property atArchive : Boolean read FatArchive write FatArchive;
    property atAnyFile : Boolean read FatAnyFile write FatAnyFile;
  end;

  TVUXFileScanner = class(tcomponent)
  private
    FBaseDir,FFilter : string;
    FRecurse,FStop : Boolean;
    Fattrib : TFileAttributes;
    FOnDataFound : TDataFoundEvent;
    FOnScanComplete,FOnStop : TNotifyEvent;
    procedure EnumFiles(Basedir,Filter : string);
    procedure EnumFilesRec(Basedir,Filter : string);
    function GetAttrCode : Integer;
    procedure SetAttrib(Value : TFileAttributes);
  public
    constructor Create(AOwner :Tcomponent) ; override;
    procedure Scan;
    destructor Destroy;override;
  published
    Property Attributes : TFileAttributes read Fattrib write Setattrib;
    Property OnDataFound : TDataFoundEvent read FOnDataFound write FOnDataFound;
    Property OnScanComplete : TNotifyEvent read FOnScanComplete write FOnScanComplete;
    Property OnStop : TNotifyEvent read FOnStop write FonStop;
    Property Recurse : Boolean read Frecurse write Frecurse;
    Property BaseDir : string read FBaseDir write FBaseDir;
    Property Filter : string read FFilter write FFilter;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('VUX Utils', [TVUXFileScanner]);
end;

constructor TVUXFileScanner.Create(AOwner : Tcomponent);
begin
  inherited Create(AOWner);
  Fattrib := TFileAttributes.Create;
end;

destructor TVUXFileScanner.Destroy;
begin
  Fattrib.Free;
  inherited destroy;
end;

procedure TVUXFileScanner.SetAttrib(Value : TFileAttributes);
begin
  Fattrib.AssignTo(Value);
end;

procedure TVUXFileScanner.Scan;
begin
  FStop := False;
  if copy(FBaseDir,length(FBasedir),1) <> '\' then
    Fbasedir := Fbasedir + '\';
  if Frecurse then EnumFilesRec(FBaseDir,FFilter)
  else EnumFiles(FBaseDir,FFilter);

  If Fstop then begin
    If assigned(OnStop) then OnStop(self);
  end else
    If assigned(OnScanComplete) then OnscanComplete(self);
end;

function TVUXFileScanner.GetAttrCode : Integer;
var
Tmp : Integer;
begin
  Tmp := 0;
  If Fattrib.atAnyFile  then
    tmp := FaAnyFile
  else begin
    If Fattrib.atReadOnly then tmp := tmp + faReadOnly;
    If Fattrib.atHidden  then tmp := tmp + fahidden;
    If Fattrib.atSysFile then tmp := tmp + faSysFile;
    If Fattrib.atVolumeID then tmp := tmp + faVolumeID;
    If Fattrib.atDirectory then tmp := tmp + faDirectory;
    If Fattrib.atArchive then tmp := tmp + faArchive;
  end;
  Result := Tmp;
end;

procedure TVUXFileScanner.EnumFiles(Basedir,Filter : string);
var
Fdata: TSearchRec;
Search: string;
Hfile: integer;
begin
search := Basedir + Filter;
Hfile := findfirst(search,getattrcode,Fdata);
if (Hfile = 0) then
begin
        repeat
          if (Fdata.Name <> '.') and (Fdata.name <> '..') then begin
            If assigned(OnDataFound) then
              ondatafound(self,BaseDir + Fdata.Name,Fdata,FStop);
          end;
        until (FindNext(Fdata) <> 0) or FStop = True;
end;
findclose(fdata);
end;

procedure TVUXFileScanner.EnumFilesRec(Basedir,Filter : string);
var
Fdata: TSearchRec;
Search: string;
Hfile: integer;
begin
search := Basedir + Filter;
Hfile := findfirst(search,getattrcode,Fdata);
if (Hfile = 0) then
begin
        repeat
          if (Fdata.Name <> '.') and (Fdata.name <> '..') then begin
            If assigned(OnDataFound) then
              ondatafound(self,BaseDir + Fdata.Name,Fdata,Fstop);
            if Directoryexists(Basedir + Fdata.name) then begin
              EnumFilesRec(Basedir + fdata.Name + '\',Filter);
            end;
          end;
        until (FindNext(Fdata) <> 0) or FStop = True;
end;
findclose(fdata);
end;

end.

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 (cs_VUX)