Veja se este componente lhe ajuda
[]Os Joel
>>------- INICIO
unit FileFind;
interface
uses Classes, Dialogs,SysUtils;
type
TFileFind = class(TComponent)
private
FContinua : Boolean;
FIsDir : Boolean;
FData : TDateTime;
FTamanho : Longint;
FDisk : ShortString;
FEnabled: boolean;
FNome: string;
FQuantFiles: LongInt;
FQuantDirs: LongInt;
FSearch: string;
FFound: string;
FDirectoryChange: string;
FCurrentFile: string;
FOnFim: TNotifyEvent;
FOnSearch: TNotifyEvent;
FOnFound: TNotifyEvent;
FOnDirectoryChange: TNotifyEvent;
procedure SetEnabled(const Value: boolean);
procedure SetSearch(const Value: string);
procedure SetFound(const Value: string);
procedure SearchFile;
public
property CurrentFile: string read FCurrentFile;
published
property QuantFiles: LongInt read FQuantFiles write FQuantFiles
default 0;
property QuantDirs: LongInt read FQuantDirs write FQuantDirs default 0;
property Nome: String read FNome write FNome;
property IsDir: Boolean read FIsDir write FIsDir;
property ContinuaOnFound : Boolean read FContinua write FContinua;
property Data: TDateTime read FData write FData;
property Tamanho: Longint read FTamanho write FTamanho;
property Disk: ShortString read FDisk write FDisk;
property Enabled: boolean read FEnabled write SetEnabled;
property Search: string read FSearch write SetSearch;
property Found: string read FFound write SetFound;
property OnSearch: TNotifyEvent read FOnSearch write FOnSearch;
property OnFound: TNotifyEvent read FOnFound write FOnFound;
property OnDirectoryChange: TNotifyEvent read FOnDirectoryChange
write FOnDirectoryChange;
property OnFim: TNotifyEvent read FOnFim write FOnFim;
end;
procedure Register;
implementation
uses Controls,{$IFDEF WIN32}Windows{$ELSE}WinProcs,WinTypes{$ENDIF};
{$IFDEF WIN32}
{$R *.R32}
{$ELSE}
{$R *.R16}
{$ENDIF}
{______________________________________________________________________________}
procedure Register;
begin
RegisterComponents('Joel',[TFileFind]);
end;
{______________________________________________________________________________}
procedure TFileFind.SetEnabled(const Value: boolean);
begin
FEnabled := Value;
FFound := '';
if FEnabled and (FSearch <> '') then
SearchFile;
end;
{______________________________________________________________________________}
procedure TFileFind.SetSearch(const Value: string);
begin
FSearch := Value;
Enabled := false;
end;
{______________________________________________________________________________}
procedure TFileFind.SetFound(const Value: string);
begin
{just to make 'Found' property appear in Object Inspector}
end;
{______________________________________________________________________________}
procedure TFileFind.SearchFile;
var
ErrorMode: word;
{____________________________________________________________________________}
procedure ProcessMessages;
var
Msg: TMsg;
begin
while PeekMessage(Msg,0,0,0,PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
{____________________________________________________________________________}
procedure ScanDirectory(FromDir: string);
var
SearchRec: TSearchRec;
SearchResult: integer;
begin
if FromDir[Length(FromDir)] <> '\' then Begin
FromDir := FromDir + '\';
Inc(FQuantDirs);
// if Assigned(FOnDirectoryChange) then
// FOnDirectoryChange(self);
End;
SearchResult := FindFirst(FromDir + '*.*', faAnyFile,SearchRec);
while (SearchResult = 0) and FEnabled do begin
ProcessMessages;
FCurrentFile := FromDir+SearchRec.Name;
if (SearchRec.Name[Length(SearchRec.Name)] <> '.') and
(Pos('..',SearchRec.Name) = 0) then Begin
Inc(FQuantFiles);
if Assigned(FOnSearch) then Begin
FNome := SearchRec.Name;
Try
FData := FileDateToDateTime( SearchRec.Time );
Except On Exception do
FData := Now();
End;
FTamanho := SearchRec.Size;
FOnSearch(self);
End;
End;
if (SearchRec.Attr and faDirectory) = faDirectory then begin
FIsDir := True;
if Assigned(FOnDirectoryChange) then
FOnDirectoryChange(self);
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then Begin
FIsDir := False;
ScanDirectory(FromDir + SearchRec.Name);
End;
end
else if CompareText(SearchRec.Name,FSearch) = 0 then begin
FIsDir := False;
FEnabled := FContinua;
FFound := FromDir + SearchRec.Name;
OnFound(Self);
end;
SearchResult := FindNext(SearchRec);
end;
SysUtils.FindClose(SearchRec);
end;
begin
ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
try
If Length(FDisk) = 1 Then
ScanDirectory(FDisk + ':\')
Else
ScanDirectory(FDisk);
finally
SetErrorMode(ErrorMode);
if Assigned(FOnFim) then
FOnFim(self);
end;
end;
end.
<<--------FIM
> preciso testar num programa
> usando findfirst - findenext
> e identificar e guardar todos diretorios e subs do hd num array
>
> testei assim
> if searchrec.attr = 16 then... //16 = diretorio
>
> so que um diretorio pode ter varios atributos
> e nesse teste nao leio muitas pastas do disco
> pois ele pode ter atributo 17= atributo diretorio mais atributo oculto
> atributo 22 = diretorio + sistema + oculto e etc
>
> como posso testar de forma que eu entre em TODAS pastas dum HD
> se for diretorio quero ler nao me interessa se eh sistema oculto
>
> entenderam?
> obrigado
>
>
>
>
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
<*> Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
<*> Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED]
Links do Yahoo! Grupos
<*> Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
<*> Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
<*> O uso que você faz do Yahoo! Grupos está sujeito aos:
http://br.yahoo.com/info/utos.html
