// FindFiles - Klasse zum Durchsuchen von Ordnern
// Michael Puff [[url]http://www.michael-puff.de][/url], himitsu, omata
unit MpuFindFilesCls;
interface
uses
Windows;
type
TOnFindFile =
procedure(Filename:
string; CountFiles: Cardinal;
const Info: TWin32FindData;
var Cancel: Boolean)
of object;
TOnFindDirectory =
procedure(Directory:
string; CountDirectories: Cardinal; Level: Cardinal;
const Info: TWin32FindData;
var Cancel: Boolean;
var IgnoreDirectory: Boolean)
of object;
TOnDirectoryUp =
procedure(FromDirectory, ToDirectory:
string;
var Cancel: Boolean)
of object;
TFindFiles =
class(TObject)
private
FSubfolders: Boolean;
FMask:
string;
FCountFiles: Cardinal;
FCountDirectories: Cardinal;
FLevel: Cardinal;
FCancel: Boolean;
FOnFindFile: TOnFindFile;
FOnFindDirectory: TOnFindDirectory;
FOnDirectoryUp: TOnDirectoryUp;
procedure Search(RootFolder:
string);
public
constructor Create;
procedure Find(RootFolder:
string);
property SubFolders: Boolean
read FSubFolders
write FSubFolders;
property Mask:
string read FMask
write FMask;
property CountFiles: Cardinal
read FCountFiles;
property CountDirectories: Cardinal
read FCountDirectories;
property OnFindFile: TOnFindFile
read FOnFindFile
write FOnFindFile;
property OnFindDirectory: TOnFindDirectory
read FOnFindDirectory
write FOnFindDirectory;
property OnDirectoryUp: TOnDirectoryUp
read FOnDirectoryUp
write FOnDirectoryUp;
end;
type
Exception =
class(TObject)
private
FMsg:
string;
class function SysErrorMessage(ErrorCode: Integer):
string;
public
constructor Create(Msg:
string);
property Msg:
string read FMsg;
end;
EFindFiles =
class(
Exception)
public
constructor Create(Msg:
string);
end;
implementation
{ TFindFiles }
constructor TFindFiles.Create;
begin
inherited;
FSubfolders := False;
FMask := '
*.*';
FCountFiles := 0;
FCountDirectories := 0;
end;
procedure TFindFiles.Search(RootFolder:
string);
var
wfd: TWin32FindData;
hFile: THandle;
Ignore: Boolean;
begin
if (RootFolder <> '
')
and (RootFolder[Length(RootFolder)] <> '
\')
then
RootFolder := RootFolder + '
\';
if not FCancel
and FSubFolders
then
begin
hFile := FindFirstFile(PChar(RootFolder + '
*.*'), wfd);
if hFile <> INVALID_HANDLE_VALUE
then
begin
try
repeat
if wfd.dwFileAttributes
and FILE_ATTRIBUTE_DIRECTORY <> 0
then
if (
string(wfd.cFileName) <> '
.')
and (
string(wfd.cFileName) <> '
..')
then
begin
Inc(FCountDirectories);
Inc(FLevel);
Ignore := False;
if Assigned(FOnFindDirectory)
then
FOnFindDirectory(RootFolder + wfd.cFileName, FCountDirectories, FLevel, wfd, FCancel, Ignore);
if not FCancel
and not Ignore
then
Search(RootFolder + wfd.cFileName + '
\');
if not FCancel
and Assigned(FOnDirectoryUp)
then
begin
FOnDirectoryUp(RootFolder + wfd.cFileName, RootFolder, FCancel);
end;
Dec(FLevel);
end;
until FCancel
or not FindNextFile(hFile, wfd);
finally
windows.FindClose(hFile);
end;
end
else
begin
raise EFindFiles.Create(
Exception.SysErrorMessage(GetLastError));
end;
end;
if not FCancel
and Assigned(OnFindFile)
then
begin
hFile := FindFirstFile(PChar(RootFolder + FMask), wfd);
if hFile <> INVALID_HANDLE_VALUE
then
begin
try
repeat
Inc(FCountFiles);
if wfd.dwFileAttributes
and FILE_ATTRIBUTE_DIRECTORY = 0
then
OnFindFile(RootFolder + wfd.cFileName, FCountFiles, wfd, FCancel);
until FCancel
or not FindNextFile(hFile, wfd);
finally
Windows.FindClose(hFile);
end;
end
else
begin
if GetLastError <> ERROR_FILE_NOT_FOUND
then
raise EFindFiles.Create(
Exception.SysErrorMessage(GetLastError));
end;
end;
end;
procedure TFindFiles.Find(RootFolder:
string);
begin
FCancel := False;
FCountFiles := 0;
FCountDirectories := 0;
FLevel := 0;
Search(RootFolder);
end;
{ Exception }
constructor Exception.Create(Msg:
string);
begin
FMsg := Msg;
end;
class function Exception.SysErrorMessage(ErrorCode: Integer):
string;
var
Len: Integer;
Buffer:
array[0..255]
of Char;
begin
Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
or
FORMAT_MESSAGE_ARGUMENT_ARRAY,
nil, ErrorCode, 0, Buffer,
SizeOf(Buffer),
nil);
while (Len > 0)
and (Buffer[Len - 1]
in [#0..#32, '
.'])
do
Dec(Len);
SetString(Result, Buffer, Len);
end;
{ EFindFiles }
constructor EFindFiles.Create(Msg:
string);
begin
inherited Create(Msg);
end;
end.