jvsearchfiles.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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 Th鰎nqvist [peter3 at sourceforge dot net]
Portions created by Peter Th鰎nqvist are Copyright (C) 2002 Peter Th鰎nqvist.
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.sourceforge.net

Description:
  Wrapper for a file search engine.

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvSearchFiles.pas,v 1.21 2005/02/17 10:20:52 marquardt Exp $

unit JvSearchFiles;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Classes, SysUtils,
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF MSWINDOWS}
  JvComponent, JvJCLUtils;

const
  { Taken from WinNT.h }
  FILE_ATTRIBUTE_SPARSE_FILE = $200;
  {$EXTERNALSYM FILE_ATTRIBUTE_SPARSE_FILE}

  FILE_ATTRIBUTE_REPARSE_POINT = $400;
  {$EXTERNALSYM FILE_ATTRIBUTE_REPARSE_POINT}

  FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = $2000;
  {$EXTERNALSYM FILE_ATTRIBUTE_NOT_CONTENT_INDEXED}

  FILE_ATTRIBUTE_ENCRYPTED = $4000;
  {$EXTERNALSYM FILE_ATTRIBUTE_ENCRYPTED}

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: '$RCSfile: JvSearchFiles.pas,v $';
    Revision: '$Revision: 1.21 $';
    Date: '$Date: 2005/02/17 10:20:52 $';
    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;