// FindFiles - Klasse zum Durchsuchen von Ordnern
// Michael Puff [[url]http://www.michael-puff.de][/url]
// Weitere Autoren: himitsu, omata
unit FindFiles;
{.$DEFINE UsesSysUtils}
interface
uses
Windows
{$IFDEF UseSysUtils} , SysUtils, DateUtils
{$ENDIF}
{$IFDEF UseClasses} , Classes
{$ENDIF};
type
TFindFiles =
class;
TOnFindFile =
procedure(Sender: TFindFiles; Directory, FileName:
string;
Level: Integer;
const Info: TWin32FindData;
var Cancel: Boolean)
of object;
TOnFindDirectory =
procedure(Sender: TFindFiles; Directory, DirName:
string;
Level: Integer;
const Info: TWin32FindData;
var Cancel: Boolean;
var IgnoreDirectory: Boolean)
of object;
TOnDirectoryUp =
procedure(Sender: TFindFiles; FromDirectory, ToDirectory:
string;
var Cancel: Boolean)
of object;
// Cancel > Cancels the entire search process.
// IgnoreDirectory > Skips the reading of this directory and all its subdirectories.
// Errors (HRESULT) > NO_ERROR = S_OK = 0
// > ERROR_FILE_NOT_FOUND = 2 > The system cannot find the file.
// > ERROR_PATH_NOT_FOUND = 3 > The system cannot find the path.
// > ERROR_NO_MORE_FILES = 18 > The user set "Cancel" in the callback to TRUE.
TFindFiles =
class
private
FMask:
string;
FSubfolders: Boolean;
FOnFindFile: TOnFindFile;
FOnFindDirectory: TOnFindDirectory;
FOnDirectoryUp: TOnDirectoryUp;
FCountFiles: Integer;
FCountDirectories: Integer;
FMaxDirectoryLevel: Integer;
FCancel: Boolean;
{$IF Declared(TStrings)}
FStrings: TStrings;
procedure StringsFindFile(Sender: TFindFiles; Directory, FileName:
string;
Level: Integer;
const Info: TWin32FindData;
var Cancel: Boolean);
{$IFEND}
function Search(RootFolder:
string; Level: Integer): HRESULT;
public
constructor Create;
property Mask:
string read FMask
write FMask;
property SubFolders: Boolean
read FSubFolders
write FSubFolders;
property OnFindFile: TOnFindFile
read FOnFindFile
write FOnFindFile;
property OnFindDirectory: TOnFindDirectory
read FOnFindDirectory
write FOnFindDirectory;
property OnDirectoryUp: TOnDirectoryUp
read FOnDirectoryUp
write FOnDirectoryUp;
function Find(RootFolder:
string): HRESULT;
// This can also be accessed via "Sender" by the callbacks from.
property CountOfFiles: Integer
read FCountFiles;
property CountOfDirectories: Integer
read FCountDirectories;
property MaximumDirectoryLevel: Integer
read FMaxDirectoryLevel;
property Cancel: Boolean
read FCancel;
class function FindEx(RootFolder, Mask:
string; SubFolders: Boolean; OnFindFile: TOnFindFile;
OnFindDirectory: TOnFindDirectory =
nil; OnDirectoryUp: TOnDirectoryUp =
nil): HRESULT;
class function isOK(E: HRESULT): Boolean;
class function GetErrorStr(E: HRESULT):
String;
class function DecodeFiletime(
const FileTime: TFileTime): TDateTime;
{$IF Declared(TStrings)}
class function FindEx(RootFolder, Mask:
string; SubFolders: Boolean; SL: TStrings): HRESULT;
overload;
{$IFEND}
end;
implementation
{$IF Declared(TStrings)}
procedure TFindFiles.StringsFindFile(Sender: TFindFiles; Directory, FileName:
string;
Level: Integer;
const Info: TWin32FindData;
var Cancel: Boolean);
begin
FStrings.Add(Directory + FileName);
end;
{$IFEND}
function TFindFiles.Search(RootFolder:
string; Level: Integer): HRESULT;
var
wfd: TWin32FindData;
hFile: THandle;
Ignore: Boolean;
Error: HRESULT;
begin
Result := NO_ERROR;
if (RootFolder <> '
')
and (RootFolder[Length(RootFolder)] <> '
\')
then
RootFolder := RootFolder + '
\';
if Level > FMaxDirectoryLevel
then
FMaxDirectoryLevel := Level;
if 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
Ignore := False;
if Assigned(FOnFindDirectory)
then
FOnFindDirectory(Self, RootFolder, wfd.cFileName, Level, wfd, FCancel, Ignore);
if not FCancel
and not Ignore
then
begin
Inc(FCountDirectories);
Error := Search(RootFolder + wfd.cFileName + '
\', Level + 1);
if Error <> S_OK
then Result := Error;
end;
if not FCancel
and Assigned(FOnDirectoryUp)
then
FOnDirectoryUp(Self, RootFolder + wfd.cFileName, RootFolder, FCancel);
end;
until FCancel
or not FindNextFile(hFile, wfd);
finally
windows.FindClose(hFile);
end;
end
else
if GetLastError <> ERROR_FILE_NOT_FOUND
then
Result := GetLastError;
end;
if not FCancel
then
begin
hFile := FindFirstFile(PChar(RootFolder + FMask), wfd);
if hFile <> INVALID_HANDLE_VALUE
then
begin
try
repeat
if wfd.dwFileAttributes
and (FILE_ATTRIBUTE_DIRECTORY
or FILE_ATTRIBUTE_DEVICE) = 0
then
begin
Inc(FCountFiles);
if Assigned(FOnFindFile)
then
FOnFindFile(Self, RootFolder, wfd.cFileName, Level, wfd, FCancel);
end;
until FCancel
or not FindNextFile(hFile, wfd);
finally
Windows.FindClose(hFile);
end;
end
else
if GetLastError <> ERROR_FILE_NOT_FOUND
then
Result := GetLastError;
end;
end;
constructor TFindFiles.Create;
begin
inherited;
FMask := '
*.*';
FSubFolders := True;
end;
function TFindFiles.Find(RootFolder:
string): HRESULT;
begin
FCountFiles := 0;
FCountDirectories := 0;
FMaxDirectoryLevel := 0;
FCancel := False;
Result := Search(RootFolder, 0);
if (Result = NO_ERROR)
and (FCountFiles = 0)
then
Result := ERROR_FILE_NOT_FOUND;
if FCancel
then Result := ERROR_NO_MORE_FILES;
end;
class function TFindFiles.FindEx(RootFolder, Mask:
string; SubFolders: Boolean; OnFindFile: TOnFindFile;
OnFindDirectory: TOnFindDirectory =
nil; OnDirectoryUp: TOnDirectoryUp =
nil): HRESULT;
var
FF: TFindFiles;
begin
FF := TFindFiles.Create;
try
FF.Mask := Mask;
FF.SubFolders := SubFolders;
FF.OnFindFile := OnFindFile;
FF.OnFindDirectory := OnFindDirectory;
FF.OnDirectoryUp := OnDirectoryUp;
Result := FF.Find(RootFolder);
finally
FF.Free;
end;
end;
class function TFindFiles.isOK(E: HRESULT): Boolean;
begin
Result := (E <> NO_ERROR)
and (E <> ERROR_FILE_NOT_FOUND);
end;
class function TFindFiles.GetErrorStr(E: HRESULT):
String;
{$IF Declared(SysErrorMessage)}
begin
Result := SysErrorMessage(E);
end;
{$ELSE}
var
Buffer:
array[0..255]
of Char;
Len: Integer;
begin
Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
or FORMAT_MESSAGE_IGNORE_INSERTS
or
FORMAT_MESSAGE_ARGUMENT_ARRAY,
nil, E, 0, Buffer, SizeOf(Buffer),
nil);
SetString(Result, Buffer, Len);
end;
{$IFEND}
class function TFindFiles.DecodeFiletime(
const FileTime: TFileTime): TDateTime;
{$IF Declared(EncodeDateTime)}
var
LocalFileTime: TFileTime;
SystemTime: TSystemTime;
begin
if FileTimeToLocalFileTime(FileTime, LocalFileTime)
and FileTimeToSystemTime(LocalFileTime, SystemTime)
then
begin
with SystemTime
do
Result := EncodeDateTime(wYear, wMonth, wDay, wHour, wMinute, wSecond, wMilliseconds);
end
else
Result := -1;
end;
{$ELSE}
const
MonthDays:
array[Boolean]
of array[1..12]
of Word =
((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
(0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335));
var
LocalFileTime: TFileTime;
SystemTime: TSystemTime;
begin
if FileTimeToLocalFileTime(FileTime, LocalFileTime)
and FileTimeToSystemTime(LocalFileTime, SystemTime)
then
begin
with SystemTime
do
begin
Dec(wYear);
Result := wYear * 365 + wYear
div 4 - wYear
div 100 + wYear
div 400 + wDay - 693594
+ MonthDays[(wYear
mod 4 = 0)
and ((wYear
mod 100 <> 0)
or (wYear
mod 400 = 0))][wMonth]
+ wHour / 24 + wMinute / 1440 + wSecond / 86400 + wMilliseconds / 86400000;
end;
end
else
Result := -1;
end;
{$IFEND}
{$IF Declared(TStrings)}
class function TFindFiles.FindEx(RootFolder, Mask:
string; SubFolders: Boolean; SL: TStrings): HRESULT;
var
FF: TFindFiles;
begin
FF := TFindFiles.Create;
try
FF.Mask := Mask;
FF.SubFolders := SubFolders;
FF.OnFindFile := FF.StringsFindFile;
FF.FStrings := SL;
FF.FStrings.BeginUpdate;
try
Result := FF.Find(RootFolder);
finally
FF.FStrings.EndUpdate;
end;
finally
FF.Free;
end;
end;
{$IFEND}
end.