Componentes.Terceros.jvcl/official/3.39/run/JvSearchFiles.pas
2010-01-18 16:55:50 +00:00

1078 lines
34 KiB
ObjectPascal

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvSearchFiles.PAS, released on 2002-05-26.
The Initial Developer of the Original Code is Peter Thrnqvist [peter3 at sourceforge dot net]
Portions created by Peter Thrnqvist are Copyright (C) 2002 Peter Thrnqvist.
All Rights Reserved.
Contributor(s):
David Frauzel (DF)
Remko Bonte
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org
Description:
Wrapper for a file search engine.
Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvSearchFiles.pas 12461 2009-08-14 17:21:33Z obones $
unit JvSearchFiles;
{$I jvcl.inc}
{$I windowsonly.inc}
interface
uses
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
Classes, SysUtils,
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF MSWINDOWS}
JvComponentBase, JvJCLUtils, JvWin32;
type
TJvAttrFlagKind = (tsMustBeSet, tsDontCare, tsMustBeUnSet);
TJvDirOption = (doExcludeSubDirs, doIncludeSubDirs, doExcludeInvalidDirs,
doExcludeCompleteInvalidDirs);
{ doExcludeSubDirs
Only search in root directory.
doIncludeSubDirs
Search in root directory and it's sub-directories.
doExcludeInvalidDirs
Search in root directory and it's sub-directories; do not search in
an invalid directory, but do search in the sub-directories of an
invalid directory.
doExcludeCompleteInvalidDirs
Search in root directory and it's sub-directories; do not search in
an invalid directory, and the sub-directories of an invalid directory.
Invalid directory = directory with params that doesn't agree with the
params specified by DirParams.
}
TJvSearchOption = (soAllowDuplicates, soCheckRootDirValid,
soExcludeFilesInRootDir, soOwnerData, soSearchDirs, soSearchFiles, soSorted,
soStripDirs, soIncludeSystemHiddenDirs, soIncludeSystemHiddenFiles);
TJvSearchOptions = set of TJvSearchOption;
{ soAllowDuplicates
Allow duplicate file/dir names in property Files and Directories.
soCheckRootDirValid
Check if the root-directory is valid; Must DirOption must be equal to
doExcludeSubDirs or doExcludeCompleteInvalidDirs, otherwise this flag is
ignored.
soExcludeFilesInRootDir
Do not search in the root directory.
soOwnerData
Do not fill property Files and Directories while searching
soSearchDirs
Search for directories; ie trigger OnFindDirectory event and update
totals [TotalDirectories, TotalFileSize] when a valid directory is found.
soSearchFiles
Search for files; ie trigger OnFindFile event and update totals
[TotalFileSize, TotalFiles] when a valid file is found.
soSorted
Keep the values in property Files and Directories sorted.
soStripDirs
Strip the path of a dir/file name before inserting it in property
Files and Directories
soIncludeSystemHiddenDirs
Do NOT ignore directories that are both system and hidden.
Examples of such directories are 'RECYCLER', 'System Volume Information' etc.
soIncludeSystemHiddenFiles
Do NOT ignore files that are both system and hidden.
Examples of such files are 'pagefile.sys', 'IO.SYS' etc.
}
TJvSearchType = (stAttribute, stFileMask, stFileMaskCaseSensitive,
stLastChangeAfter, stLastChangeBefore, stMaxSize, stMinSize);
TJvSearchTypes = set of TJvSearchType;
TJvFileSearchEvent = procedure(Sender: TObject; const AName: string) of object;
TJvSearchFilesError = procedure(Sender: TObject; var Handled: Boolean) of object;
TJvCheckEvent = procedure(Sender: TObject; var Result: Boolean) of object;
TJvErrorResponse = (erAbort, erIgnore, erRaise);
TJvSearchAttributes = class(TPersistent)
private
FIncludeAttr: DWORD;
FExcludeAttr: DWORD;
function GetAttr(const Index: Integer): TJvAttrFlagKind;
procedure SetAttr(const Index: Integer; Value: TJvAttrFlagKind);
procedure ReadIncludeAttr(Reader: TReader);
procedure ReadExcludeAttr(Reader: TReader);
procedure WriteIncludeAttr(Writer: TWriter);
procedure WriteExcludeAttr(Writer: TWriter);
protected
{ DefineProperties is used to publish properties IncludeAttr and
ExcludeAttr }
procedure DefineProperties(Filer: TFiler); override;
public
procedure Assign(Source: TPersistent); override;
property IncludeAttr: DWORD read FIncludeAttr write FIncludeAttr;
property ExcludeAttr: DWORD read FExcludeAttr write FExcludeAttr;
published
property ReadOnly: TJvAttrFlagKind index FILE_ATTRIBUTE_READONLY read GetAttr
write SetAttr stored False;
property Hidden: TJvAttrFlagKind index FILE_ATTRIBUTE_HIDDEN
read GetAttr write SetAttr stored False;
property System: TJvAttrFlagKind index FILE_ATTRIBUTE_SYSTEM
read GetAttr write SetAttr stored False;
property Archive: TJvAttrFlagKind index FILE_ATTRIBUTE_ARCHIVE
read GetAttr write SetAttr stored False;
property Normal: TJvAttrFlagKind index FILE_ATTRIBUTE_NORMAL
read GetAttr write SetAttr stored False;
property Temporary: TJvAttrFlagKind index FILE_ATTRIBUTE_TEMPORARY
read GetAttr write SetAttr stored False;
property SparseFile: TJvAttrFlagKind index FILE_ATTRIBUTE_SPARSE_FILE
read GetAttr write SetAttr stored False;
property ReparsePoint: TJvAttrFlagKind index FILE_ATTRIBUTE_REPARSE_POINT
read GetAttr write SetAttr stored False;
property Compressed: TJvAttrFlagKind index FILE_ATTRIBUTE_COMPRESSED
read GetAttr write SetAttr stored False;
property OffLine: TJvAttrFlagKind index FILE_ATTRIBUTE_OFFLINE
read GetAttr write SetAttr stored False;
property NotContentIndexed: TJvAttrFlagKind index
FILE_ATTRIBUTE_NOT_CONTENT_INDEXED read GetAttr write SetAttr stored False;
property Encrypted: TJvAttrFlagKind index FILE_ATTRIBUTE_ENCRYPTED read
GetAttr write SetAttr stored False;
end;
TJvSearchParams = class(TPersistent)
private
FMaxSizeHigh: Cardinal;
FMaxSizeLow: Cardinal;
FMinSizeHigh: Cardinal;
FMinSizeLow: Cardinal;
FLastChangeBefore: TDateTime;
FLastChangeBeforeFT: TFileTime;
FLastChangeAfter: TDateTime;
FLastChangeAfterFT: TFileTime;
FSearchTypes: TJvSearchTypes;
FFileMasks: TStringList;
FCaseFileMasks: TStringList;
FFileMaskSeperator: Char;
FAttributes: TJvSearchAttributes;
procedure FileMasksChange(Sender: TObject);
function GetFileMask: string;
function GetMaxSize: Int64;
function GetMinSize: Int64;
function GetFileMasks: TStrings;
function IsLastChangeAfterStored: Boolean;
function IsLastChangeBeforeStored: Boolean;
procedure SetAttributes(const Value: TJvSearchAttributes);
procedure SetFileMasks(const Value: TStrings);
procedure SetFileMask(const Value: string);
procedure SetLastChangeAfter(const Value: TDateTime);
procedure SetLastChangeBefore(const Value: TDateTime);
procedure SetMaxSize(const Value: Int64);
procedure SetMinSize(const Value: Int64);
procedure SetSearchTypes(const Value: TJvSearchTypes);
procedure UpdateCaseMasks;
public
constructor Create; virtual;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
function Check(const AFindData: TWin32FindData): Boolean;
property FileMask: string read GetFileMask write SetFileMask;
property FileMaskSeperator: Char read FFileMaskSeperator write
FFileMaskSeperator default ';';
published
property Attributes: TJvSearchAttributes read FAttributes write SetAttributes;
property SearchTypes: TJvSearchTypes read FSearchTypes write SetSearchTypes default [];
property MinSize: Int64 read GetMinSize write SetMinSize;
property MaxSize: Int64 read GetMaxSize write SetMaxSize;
property LastChangeAfter: TDateTime read FLastChangeAfter write SetLastChangeAfter
stored IsLastChangeAfterStored;
property LastChangeBefore: TDateTime read FLastChangeBefore write SetLastChangeBefore
stored IsLastChangeBeforeStored;
property FileMasks: TStrings read GetFileMasks write SetFileMasks;
end;
TJvSearchFiles = class(TJvComponent)
private
FSearching: Boolean;
FTotalDirectories: Integer;
FTotalFiles: Integer;
FTotalFileSize: Int64;
FRootDirectory: string;
FOnFindFile: TJvFileSearchEvent;
FOnFindDirectory: TJvFileSearchEvent;
FOptions: TJvSearchOptions;
FOnAbort: TNotifyEvent;
FOnError: TJvSearchFilesError;
FOnProgress: TNotifyEvent;
FDirectories: TStringList;
FFiles: TStringList;
FFindData: TWin32FindData;
FAborting: Boolean;
FErrorResponse: TJvErrorResponse;
FOnCheck: TJvCheckEvent;
FOnBeginScanDir: TJvFileSearchEvent;
FDirOption: TJvDirOption;
FDirParams: TJvSearchParams;
FFileParams: TJvSearchParams;
FRecurseDepth: Integer;
function GetIsRootDirValid: Boolean;
function GetIsDepthAllowed(const ADepth: Integer): Boolean;
function GetDirectories: TStrings;
function GetFiles: TStrings;
procedure SetDirParams(const Value: TJvSearchParams);
procedure SetFileParams(const Value: TJvSearchParams);
procedure SetOptions(const Value: TJvSearchOptions);
protected
procedure DoBeginScanDir(const ADirName: string); virtual;
procedure DoFindFile(const APath: string); virtual;
procedure DoFindDir(const APath: string); virtual;
procedure DoAbort; virtual;
procedure DoProgress; virtual;
function DoCheckDir: Boolean; virtual;
function DoCheckFile: Boolean; virtual;
function HandleError: Boolean; virtual;
procedure Init; virtual;
function EnumFiles(const ADirectoryName: string; Dirs: TStrings;
const Search: Boolean): Boolean;
function InternalSearch(const ADirectoryName: string;
const Search: Boolean; var ADepth: Integer): Boolean; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Abort;
function Search: Boolean;
property FindData: TWin32FindData read FFindData;
property Files: TStrings read GetFiles;
property Directories: TStrings read GetDirectories;
property IsRootDirValid: Boolean read GetIsRootDirValid;
property Searching: Boolean read FSearching;
property TotalDirectories: Integer read FTotalDirectories;
property TotalFileSize: Int64 read FTotalFileSize;
property TotalFiles: Integer read FTotalFiles;
published
property DirOption: TJvDirOption read FDirOption write FDirOption default doIncludeSubDirs;
// RecurseDepth sets the number of subfolders to search. If 0, all subfolders
// are searched (as long as doIncludeSubDirs is true)
property RecurseDepth: Integer read FRecurseDepth write FRecurseDepth default 0;
property RootDirectory: string read FRootDirectory write FRootDirectory;
property Options: TJvSearchOptions read FOptions write SetOptions default [soSearchFiles];
property ErrorResponse: TJvErrorResponse read FErrorResponse write
FErrorResponse default erAbort;
property DirParams: TJvSearchParams read FDirParams write SetDirParams;
property FileParams: TJvSearchParams read FFileParams write SetFileParams;
property OnBeginScanDir: TJvFileSearchEvent read FOnBeginScanDir write
FOnBeginScanDir;
property OnFindFile: TJvFileSearchEvent read FOnFindFile write FOnFindFile;
property OnFindDirectory: TJvFileSearchEvent read FOnFindDirectory write
FOnFindDirectory;
property OnAbort: TNotifyEvent read FOnAbort write FOnAbort;
property OnError: TJvSearchFilesError read FOnError write FOnError;
{ Maybe add a flag to Options to disable OnCheck }
property OnCheck: TJvCheckEvent read FOnCheck write FOnCheck;
// (rom) replaced ProcessMessages with OnProgress event
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
end;
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_39/run/JvSearchFiles.pas $';
Revision: '$Revision: 12461 $';
Date: '$Date: 2009-08-14 19:21:33 +0200 (ven., 14 août 2009) $';
LogPath: 'JVCL\run'
);
{$ENDIF UNITVERSIONING}
implementation
uses
JclStrings, JclDateTime;
{ Maybe TJvSearchFiles should be implemented with FindFirst, FindNext.
There isn't a good reason to use FindFirstFile, FindNextFile instead of
FindFirst, FindNext; except to prevent a little overhead perhaps. }
const
CDate1_1_1980 = 29221;
function IsDotOrDotDot(P: PChar): Boolean;
begin
// check if a string is '.' (self) or '..' (parent)
if P^ = '.' then
begin
Inc(P);
Result := (P^ = #0) or ((P^ = '.') and ((P+1)^ = #0));
end
else
Result := False;
end;
function IsSystemAndHidden(const AFindData: TWin32FindData): Boolean;
const
cSystemHidden = FILE_ATTRIBUTE_SYSTEM or FILE_ATTRIBUTE_HIDDEN;
begin
with AFindData do
Result := dwFileAttributes and cSystemHidden = cSystemHidden;
end;
//=== { TJvSearchFiles } =====================================================
constructor TJvSearchFiles.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFiles := TStringList.Create;
FDirectories := TStringList.Create;
FDirParams := TJvSearchParams.Create;
FFileParams := TJvSearchParams.Create;
{ defaults }
Options := [soSearchFiles];
DirOption := doIncludeSubDirs;
ErrorResponse := erAbort;
//FFileParams.SearchTypes := [stFileMask];
end;
destructor TJvSearchFiles.Destroy;
begin
FFiles.Free;
FDirectories.Free;
FFileParams.Free;
FDirParams.Free;
inherited Destroy;
end;
procedure TJvSearchFiles.Abort;
begin
if not FSearching then
Exit;
FAborting := True;
DoAbort;
end;
procedure TJvSearchFiles.DoAbort;
begin
if Assigned(FOnAbort) then
FOnAbort(Self);
end;
procedure TJvSearchFiles.DoProgress;
begin
if Assigned(FOnProgress) then
FOnProgress(Self);
end;
procedure TJvSearchFiles.DoBeginScanDir(const ADirName: string);
begin
if Assigned(FOnBeginScanDir) then
FOnBeginScanDir(Self, ADirName);
end;
function TJvSearchFiles.DoCheckDir: Boolean;
begin
if Assigned(FOnCheck) then
begin
Result := False;
FOnCheck(Self, Result);
end
else
Result := FDirParams.Check(FFindData)
end;
function TJvSearchFiles.DoCheckFile: Boolean;
begin
if not (soIncludeSystemHiddenFiles in Options) and IsSystemAndHidden(FFindData) then
begin
Result := False;
Exit;
end
else
if Assigned(FOnCheck) then
begin
Result := False;
FOnCheck(Self, Result);
end
else
Result := FFileParams.Check(FFindData)
end;
procedure TJvSearchFiles.DoFindDir(const APath: string);
var
DirName: string;
FileSize: Int64;
begin
Inc(FTotalDirectories);
with FindData do
begin
if soStripDirs in Options then
DirName := cFileName
else
DirName := APath + cFileName;
if not (soOwnerData in Options) then
Directories.Add(DirName);
Int64Rec(FileSize).Lo := nFileSizeLow;
Int64Rec(FileSize).Hi := nFileSizeHigh;
Inc(FTotalFileSize, FileSize);
{ NOTE: soStripDirs also applies to the event }
if Assigned(FOnFindDirectory) then
FOnFindDirectory(Self, DirName);
end;
end;
procedure TJvSearchFiles.DoFindFile(const APath: string);
var
FileName: string;
FileSize: Int64;
begin
Inc(FTotalFiles);
with FindData do
begin
if soStripDirs in Options then
FileName := cFileName
else
FileName := APath + cFileName;
if not (soOwnerData in Options) then
Files.Add(FileName);
Int64Rec(FileSize).Lo := nFileSizeLow;
Int64Rec(FileSize).Hi := nFileSizeHigh;
Inc(FTotalFileSize, FileSize);
{ NOTE: soStripDirs also applies to the event }
if Assigned(FOnFindFile) then
FOnFindFile(Self, FileName);
end;
end;
function TJvSearchFiles.EnumFiles(const ADirectoryName: string;
Dirs: TStrings; const Search: Boolean): Boolean;
var
Handle: THandle;
Finished: Boolean;
DirOK: Boolean;
begin
DoBeginScanDir(ADirectoryName);
{ Always scan the full directory - ie use * as mask - this seems faster
then first using a mask, and then scanning the directory for subdirs }
Handle := FindFirstFile(PChar(ADirectoryName + '*'), FFindData);
Result := Handle <> INVALID_HANDLE_VALUE;
if not Result then
begin
Result := GetLastError in [ERROR_FILE_NOT_FOUND, ERROR_ACCESS_DENIED];;
Exit;
end;
Finished := False;
try
while not Finished do
begin
// (p3) no need to bring in the Forms unit for this:
if not IsConsole then
DoProgress;
{ After DoProgress, the user can have called Abort,
so check it }
if FAborting then
begin
Result := False;
Exit;
end;
with FFindData do
{ Is it a directory? }
if dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0 then
begin
{ Filter out '.' and '..'
Other dir names can't begin with a '.' }
{ | Event | AddDir | SearchInDir
-----------------------------------------------------------------
doExcludeSubDirs |
True | Y N N
False | N N N
doIncludeSubDirs |
True | Y Y Y
False | N Y Y
doExcludeInvalidDirs |
True | Y Y Y
False | N Y N
doExcludeCompleteInvalidDirs |
True | Y Y Y
False | N N N
}
if not IsDotOrDotDot(cFileName) and
((soIncludeSystemHiddenDirs in Options) or not IsSystemAndHidden(FFindData)) then
{ Use case to prevent unnecessary calls to DoCheckDir }
case DirOption of
doExcludeSubDirs, doIncludeSubDirs:
begin
if Search and (soSearchDirs in Options) and DoCheckDir then
DoFindDir(ADirectoryName);
if DirOption = doIncludeSubDirs then
Dirs.AddObject(cFileName, TObject(True))
end;
doExcludeInvalidDirs, doExcludeCompleteInvalidDirs:
begin
DirOK := DoCheckDir;
if Search and (soSearchDirs in Options) and DirOK then
DoFindDir(ADirectoryName);
if (DirOption = doExcludeInvalidDirs) or DirOK then
Dirs.AddObject(cFileName, TObject(DirOK));
end;
end;
end
else
if Search and (soSearchFiles in Options) and DoCheckFile then
DoFindFile(ADirectoryName);
if not FindNextFile(Handle, FFindData) then
begin
Finished := True;
Result := GetLastError = ERROR_NO_MORE_FILES;
end;
end;
finally
Result := FindClose(Handle) and Result;
end;
end;
function TJvSearchFiles.GetIsRootDirValid: Boolean;
var
Handle: THandle;
begin
Handle := FindFirstFile(PChar(ExcludeTrailingPathDelimiter(FRootDirectory)),
FFindData);
Result := Handle <> INVALID_HANDLE_VALUE;
if not Result then
Exit;
try
with FFindData do
Result := (dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0) and
(cFileName[0] <> '.') and DoCheckDir;
finally
FindClose(Handle);
end;
end;
function TJvSearchFiles.GetIsDepthAllowed(const ADepth: Integer): Boolean;
begin
Result := (FRecurseDepth = 0) or (ADepth <= FRecurseDepth);
end;
function TJvSearchFiles.HandleError: Boolean;
begin
{ ErrorResponse = erIgnore : Result = True
ErrorResponse = erAbort : Result = False
ErrorResponse = erRaise : The last error is raised.
If a user implements an OnError event handler, these results can be
overridden.
}
if FAborting then
begin
Result := False;
Exit;
end;
Result := FErrorResponse = erIgnore;
if Assigned(FOnError) then
FOnError(Self, Result);
if (FErrorResponse = erRaise) and not Result then
RaiseLastOSError;
end;
function TJvSearchFiles.GetDirectories: TStrings;
begin
Result := FDirectories;
end;
function TJvSearchFiles.GetFiles: TStrings;
begin
Result := FFiles;
end;
procedure TJvSearchFiles.Init;
begin
FTotalFileSize := 0;
FTotalDirectories := 0;
FTotalFiles := 0;
Directories.Clear;
Files.Clear;
FAborting := False;
end;
function TJvSearchFiles.InternalSearch(const ADirectoryName: string; const Search: Boolean;
var ADepth: Integer): Boolean;
var
List: TStringList;
DirSep: string;
I: Integer;
begin
List := TStringList.Create;
try
DirSep := IncludeTrailingPathDelimiter(ADirectoryName);
Result := EnumFiles(DirSep, List, Search) or HandleError;
if not Result then
Exit;
{ DO NOT set Result := False; the search should continue, this is not an error. }
Inc(ADepth);
if not GetIsDepthAllowed(ADepth) then
Exit;
{ I think it would be better to do no recursion; Don't know if it can
be easy implemented - if you want to keep the depth first search -
and without doing a lot of TList moves }
for I := 0 to List.Count - 1 do
begin
Result := InternalSearch(DirSep + List[I], List.Objects[I] <> nil, ADepth);
if not Result then
Exit;
end;
finally
List.Free;
Dec(ADepth);
end;
end;
function TJvSearchFiles.Search: Boolean;
var
SearchInRootDir: Boolean;
ADepth: Integer;
begin
Result := False;
if Searching then
Exit;
Init;
FSearching := True;
try
{ Search in root directory?
| soExcludeFiles | soCheckRootDirValid | Else
| InRootDir | |
| | Valid | not Valid |
--------------------------------------------------------------------------
doExcludeSubDirs | No Search | True | No Search | True
doIncludeSubDirs | False | True | False | True
doExcludeInvalidDirs | False | True | False | True
doExcludeCompleteInvalidDirs | False | True | No Search | True
}
SearchInRootDir := not (soExcludeFilesInRootDir in Options) and
(not (soCheckRootDirValid in Options) or IsRootDirValid);
if not SearchInRootDir and ((DirOption = doExcludeSubDirs) or
((DirOption = doExcludeCompleteInvalidDirs) and
(soCheckRootDirValid in Options))) then
begin
Result := True;
Exit;
end;
ADepth := 0;
Result := InternalSearch(FRootDirectory, SearchInRootDir, ADepth);
finally
FSearching := False;
end;
end;
procedure TJvSearchFiles.SetDirParams(const Value: TJvSearchParams);
begin
FDirParams.Assign(Value);
end;
procedure TJvSearchFiles.SetFileParams(const Value: TJvSearchParams);
begin
FFileParams.Assign(Value);
end;
procedure TJvSearchFiles.SetOptions(const Value: TJvSearchOptions);
var
ChangedOptions: TJvSearchOptions;
begin
{ I'm not sure, what to do when the user changes property Options, while
the component is searching for files. As implemented now, the component
just changes the options, and doesn't ensure that the properties hold
for all data. For example unsetting flag soStripDirs while searching,
results in a file list with values stripped, and other values not stripped.
An other option could be to raise an exception when the user tries to
change Options while the component is searching. But because no serious
harm is caused - by changing Options, while searching - the component
doen't do that.
}
{ (p3) you could also do:
if Searching then Exit;
}
// (rom) even better the search should use a local copy which stays unchanged
if FOptions <> Value then
begin
ChangedOptions := FOptions + Value - (FOptions * Value);
FOptions := Value;
if soSorted in ChangedOptions then
begin
FDirectories.Sorted := soSorted in FOptions;
FFiles.Sorted := soSorted in FOptions;
end;
if soAllowDuplicates in ChangedOptions then
begin
if soAllowDuplicates in FOptions then
begin
FDirectories.Duplicates := dupAccept;
FFiles.Duplicates := dupAccept;
end
else
begin
FDirectories.Duplicates := dupIgnore;
FFiles.Duplicates := dupIgnore;
end;
end;
// soStripDirs; soIncludeSubDirs; soOwnerData
end;
end;
//=== { TJvSearchAttributes } ================================================
procedure TJvSearchAttributes.Assign(Source: TPersistent);
begin
if Source is TJvSearchAttributes then
begin
IncludeAttr := TJvSearchAttributes(Source).IncludeAttr;
ExcludeAttr := TJvSearchAttributes(Source).ExcludeAttr;
end
else
inherited Assign(Source);
end;
procedure TJvSearchAttributes.DefineProperties(Filer: TFiler);
var
Ancestor: TJvSearchAttributes;
Attr: DWORD;
begin
Attr := 0;
Ancestor := TJvSearchAttributes(Filer.Ancestor);
if Assigned(Ancestor) then
Attr := Ancestor.FIncludeAttr;
Filer.DefineProperty('IncludeAttr', ReadIncludeAttr, WriteIncludeAttr,
Attr <> FIncludeAttr);
if Assigned(Ancestor) then
Attr := Ancestor.FExcludeAttr;
Filer.DefineProperty('ExcludeAttr', ReadExcludeAttr, WriteExcludeAttr,
Attr <> FExcludeAttr);
end;
function TJvSearchAttributes.GetAttr(const Index: Integer): TJvAttrFlagKind;
begin
if FIncludeAttr and Index > 0 then
Result := tsMustBeSet
else
if FExcludeAttr and Index > 0 then
Result := tsMustBeUnSet
else
Result := tsDontCare;
end;
procedure TJvSearchAttributes.ReadExcludeAttr(Reader: TReader);
begin
FExcludeAttr := Reader.ReadInteger;
end;
procedure TJvSearchAttributes.ReadIncludeAttr(Reader: TReader);
begin
FIncludeAttr := Reader.ReadInteger;
end;
procedure TJvSearchAttributes.SetAttr(const Index: Integer;
Value: TJvAttrFlagKind);
begin
case Value of
tsMustBeSet:
begin
FIncludeAttr := FIncludeAttr or DWORD(Index);
FExcludeAttr := FExcludeAttr and not Index;
end;
tsMustBeUnSet:
begin
FIncludeAttr := FIncludeAttr and not Index;
FExcludeAttr := FExcludeAttr or DWORD(Index);
end;
tsDontCare:
begin
FIncludeAttr := FIncludeAttr and not Index;
FExcludeAttr := FExcludeAttr and not Index;
end;
end;
end;
procedure TJvSearchAttributes.WriteExcludeAttr(Writer: TWriter);
begin
Writer.WriteInteger(FExcludeAttr);
end;
procedure TJvSearchAttributes.WriteIncludeAttr(Writer: TWriter);
begin
Writer.WriteInteger(FIncludeAttr);
end;
//=== { TJvSearchParams } ====================================================
constructor TJvSearchParams.Create;
begin
// (rom) added inherited Create
inherited Create;
FAttributes := TJvSearchAttributes.Create;
FFileMasks := TStringList.Create;
FFileMasks.OnChange := FileMasksChange;
FCaseFileMasks := TStringList.Create;
{ defaults }
FFileMaskSeperator := ';';
{ Set to 1-1-1980 }
FLastChangeBefore := CDate1_1_1980;
FLastChangeAfter := CDate1_1_1980;
end;
destructor TJvSearchParams.Destroy;
begin
FAttributes.Free;
FFileMasks.Free;
FCaseFileMasks.Free;
inherited Destroy;
end;
procedure TJvSearchParams.Assign(Source: TPersistent);
var
Src: TJvSearchParams;
begin
if Source is TJvSearchParams then
begin
Src := TJvSearchParams(Source);
MaxSize := Src.MaxSize;
MinSize := Src.MinSize;
LastChangeBefore := Src.LastChangeBefore;
LastChangeAfter := Src.LastChangeAfter;
SearchTypes := Src.SearchTypes;
FileMasks.Assign(Src.FileMasks);
FileMaskSeperator := Src.FileMaskSeperator;
Attributes.Assign(Src.Attributes);
end
else
inherited Assign(Source);
end;
function TJvSearchParams.Check(const AFindData: TWin32FindData): Boolean;
var
I: Integer;
FileName: string;
begin
Result := False;
with AFindData do
begin
if stAttribute in FSearchTypes then
begin
{ Note that if you set a flag in both ExcludeAttr and IncludeAttr
the search always returns False }
if dwFileAttributes and Attributes.ExcludeAttr > 0 then
Exit;
if dwFileAttributes and Attributes.IncludeAttr <> Attributes.IncludeAttr then
Exit;
end;
if stMinSize in FSearchTypes then
if (nFileSizeHigh < FMinSizeHigh) or
((nFileSizeHigh = FMinSizeHigh) and (nFileSizeLow < FMinSizeLow)) then
Exit;
if stMaxSize in FSearchTypes then
if (nFileSizeHigh > FMaxSizeHigh) or
((nFileSizeHigh = FMaxSizeHigh) and (nFileSizeLow > FMaxSizeLow)) then
Exit;
if stLastChangeAfter in FSearchTypes then
if CompareFileTime(ftLastWriteTime, FLastChangeAfterFT) < 0 then
Exit;
if stLastChangeBefore in FSearchTypes then
if CompareFileTime(ftLastWriteTime, FLastChangeBeforeFT) > 0 then
Exit;
if (stFileMask in FSearchTypes) and (FFileMasks.Count > 0) then
begin
{ StrMatches in JclStrings.pas is case-sensitive, thus for non case-
sensitive search we have to do a little trick. The filename is
upper-cased and compared with masks that are also upper-cased.
This is a bit clumsy; a better solution would be to do this in
StrMatches.
I guess a lot of masks have the format 'mask*' or '*.ext'; so
if you could specifiy to do a left or right scan in StrMatches
would be better too. Note that if no char follows a '*', the
result is always true; this isn't implemented so in StrMatches }
if stFileMaskCaseSensitive in SearchTypes then
FileName := cFileName
else
FileName := AnsiUpperCase(cFileName);
I := 0;
while (I < FFileMasks.Count) and
not JclStrings.StrMatches(FCaseFileMasks[I], FileName) do
Inc(I);
if I >= FFileMasks.Count then
Exit;
end;
end;
Result := True;
end;
procedure TJvSearchParams.FileMasksChange(Sender: TObject);
begin
UpdateCaseMasks;
end;
function TJvSearchParams.GetFileMask: string;
begin
Result := JclStrings.StringsToStr(FileMasks, FileMaskSeperator);
end;
function TJvSearchParams.GetMaxSize: Int64;
begin
Int64Rec(Result).Lo := FMaxSizeLow;
Int64Rec(Result).Hi := FMaxSizeHigh;
end;
function TJvSearchParams.GetMinSize: Int64;
begin
Int64Rec(Result).Lo := FMinSizeLow;
Int64Rec(Result).Hi := FMinSizeHigh;
end;
function TJvSearchParams.GetFileMasks: TStrings;
begin
Result := FFileMasks;
end;
function TJvSearchParams.IsLastChangeAfterStored: Boolean;
begin
Result := FLastChangeBefore <> CDate1_1_1980;
end;
function TJvSearchParams.IsLastChangeBeforeStored: Boolean;
begin
Result := FLastChangeBefore <> CDate1_1_1980;
end;
procedure TJvSearchParams.SetAttributes(const Value: TJvSearchAttributes);
begin
FAttributes.Assign(Value);
end;
procedure TJvSearchParams.SetFileMask(const Value: string);
begin
JclStrings.StrToStrings(Value, FileMaskSeperator, FileMasks);
end;
procedure TJvSearchParams.SetFileMasks(const Value: TStrings);
begin
FFileMasks.Assign(Value);
end;
procedure TJvSearchParams.SetLastChangeAfter(const Value: TDateTime);
var
DosFileTime: Longint;
LocalFileTime: TFileTime;
begin
{ Value must be >= 1-1-1980 }
DosFileTime := DateTimeToDosDateTime(Value);
if not Windows.DosDateTimeToFileTime(LongRec(DosFileTime).Hi,
LongRec(DosFileTime).Lo, LocalFileTime) or
not Windows.LocalFileTimeToFileTime(LocalFileTime, FLastChangeAfterFT) then
RaiseLastOSError;
FLastChangeAfter := Value;
end;
procedure TJvSearchParams.SetLastChangeBefore(const Value: TDateTime);
var
DosFileTime: Longint;
LocalFileTime: TFileTime;
begin
{ Value must be >= 1-1-1980 }
DosFileTime := DateTimeToDosDateTime(Value);
if not Windows.DosDateTimeToFileTime(LongRec(DosFileTime).Hi,
LongRec(DosFileTime).Lo, LocalFileTime) or
not Windows.LocalFileTimeToFileTime(LocalFileTime, FLastChangeBeforeFT) then
RaiseLastOSError;
FLastChangeBefore := Value;
end;
procedure TJvSearchParams.SetMaxSize(const Value: Int64);
begin
FMaxSizeHigh := Int64Rec(Value).Hi;
FMaxSizeLow := Int64Rec(Value).Lo;
end;
procedure TJvSearchParams.SetMinSize(const Value: Int64);
begin
FMinSizeHigh := Int64Rec(Value).Hi;
FMinSizeLow := Int64Rec(Value).Lo;
end;
procedure TJvSearchParams.SetSearchTypes(const Value: TJvSearchTypes);
var
ChangedValues: TJvSearchTypes;
begin
if FSearchTypes = Value then
Exit;
ChangedValues := FSearchTypes + Value - (FSearchTypes * Value);
FSearchTypes := Value;
if stFileMaskCaseSensitive in ChangedValues then
UpdateCaseMasks;
end;
procedure TJvSearchParams.UpdateCaseMasks;
var
I: Integer;
begin
FCaseFileMasks.Assign(FileMasks);
if not (stFileMaskCaseSensitive in SearchTypes) then
for I := 0 to FCaseFileMasks.Count - 1 do
FCaseFileMasks[I] := AnsiUpperCase(FCaseFileMasks[I]);
end;
{$IFDEF UNITVERSIONING}
initialization
RegisterUnitVersion(HInstance, UnitVersioning);
finalization
UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
end.