filefind.pas

ComPort Library 是一组通信组件。它包括：TComPort、TComData- Packet、TComComboBox、TComRadioGroup、TComLed、TComTermin

{ -------------------------------------------------------------------------------------}
{ A "file finder" component for Delphi32.                                              }
{ Copyright 1997, Patrick Brisacier and Jean-Fabien Connault.  All Rights Reserved.    }
{ This component can be freely used and distributed in commercial and private          }
{ environments, provided this notice is not modified in any way.                       }
{ -------------------------------------------------------------------------------------}
{ Feel free to contact us if you have any questions, comments or suggestions at        }
{   [e-mail] (Patrick Brisacier)                                      }
{   [e-mail] (Jean-Fabien Connault)                                   }
{ You can always find the latest version of this component at:                         }
{   http://www.worldnet.net/~cycocrew/delphi/                                          }
{ -------------------------------------------------------------------------------------}
{ Thanks to St閜ahne Pau ([e-mail]) for enhancing features of TFileFind.          }
{ -------------------------------------------------------------------------------------}
{ Date last modified:  07/04/97                                                        }
{ -------------------------------------------------------------------------------------}

{ -------------------------------------------------------------------------------------}
{ TFileFind v1.06                                                                      }
{ -------------------------------------------------------------------------------------}
{ Description:                                                                         }
{   A component that allows you to find files through drives.                          }
{ Properties:                                                                          }
{   property DirType: TFileType;                                                       }
{   property FileType: TFileType;                                                      }
{   property FilePattern: String;                                                      }
{   property FilesFound: TStringList;                                                  }
{   property MatchCaseSensitive: Boolean;                                              }
{   property MatchEnabled: Boolean;                                                    }
{   property MatchString: String;                                                      }
{   property Priority: TThreadPriority;                                                }
{   property Recursive: Boolean;                                                       }
{   property StartDir: String;                                                         }
{   property OnTerminated: TNotifyEvent;                                               }
{ Procedures and functions:                                                            }
{   procedure Execute;                                                                 }
{   procedure ThreadExecute;                                                           }
{ Needs:                                                                               }
{   TBrkApart component from Patrick Brisacier and Jean-Fabien Connault                }
{   TMatch component from Patrick Brisacier and Jean-Fabien Connault                   }
{                                                                                      }
{ See example contained in example.zip file for more details.                          }
{ -------------------------------------------------------------------------------------}
{ Revision History:                                                                    }
{ 1.00:  + Initial release                                                             }
{ 1.01:  + Added Recursive property                                                    }
{ 1.02:  + Added support for french and english languages                              }
{ 1.03:  + Added MatchEnable, MatchString and MatchCaseSensitive properties            }
{        + Renamed Priority property in ThreadPriority                                 }
{ 1.04   + Renamed MatchEnable property in MatchEnabled                                }
{ 1.05   + Added FileType property                                                     }
{ 1.06   + Added DirType property (not published and not active by default)            }
{        + Removed the FilesFound properties from the published properties             }
{ -------------------------------------------------------------------------------------}

unit FileFind;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, BrkApart, Match, FileCtrl;

type
  {*********************************************************************}
  { Exceptions                                                          }
  {*********************************************************************}
  EFileFind = class(Exception);
  EFileFindChDir = class(EFileFind);
  EFileFindOutOfResources = class(EFileFind);

  {*********************************************************************}
  { TFileFind                                                           }
  {*********************************************************************}
  TFileFind = class(TComponent)
  private
    { D閏larations private }
    FDirType: TFileType;
    FDirTypeWord: Word;
    FFilePattern: TStringList;
    FFilesFound: TStringList;
    FFileType: TFileType;
    FFileTypeWord: Word;
    FMatchCaseSensitive: Boolean;
    FMatchEnabled: Boolean;
    FMatchString: String;
    FThreadPriority: TThreadPriority;
    FRecursive: Boolean;
    FStartDir: TStringList;
    FOnTerminated: TNotifyEvent;
    FConvert: TBrkApart;
    FMatch: TMatch;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetFileType(NewFileType: TFileType);
    procedure SetDirType(NewDirType: TFileType);
    function GetFilePattern: String;
    procedure SetFilePattern(AFilePattern: String);
    procedure SetFilesFound(AFilesFound: TStringList);
    function GetStartDir: String;
    procedure SetStartDir(AStartDir: String);
    function CheckDir(ADir: String): String;
    procedure FindThreadDone(Sender: TObject);
  protected
    { D閏larations protected }
  public
    { D閏larations public }
    property DirType: TFileType read FDirType write SetDirType default [ftDirectory];
    property FilesFound: TStringList read FFilesFound write SetFilesFound;
    procedure Execute;
    procedure ThreadExecute;
  published
    { D閏larations published }
    property FilePattern: String read GetFilePattern write SetFilePattern;
    property FileType: TFileType read FFileType write SetFileType default [ftNormal];
    property MatchCaseSensitive: Boolean read FMatchCaseSensitive write FMatchCaseSensitive;
    property MatchEnabled: Boolean read FMatchEnabled write FMatchEnabled;
    property MatchString: String read FMatchString write FMatchString;
    property Recursive: Boolean read FRecursive write FRecursive default True;
    property StartDir: String read GetStartDir write SetStartDir;
    property ThreadPriority: TThreadPriority read FThreadPriority write FThreadPriority;
    property OnTerminated: TNotifyEvent read FOnTerminated write FOnTerminated;
  end;

  {*********************************************************************}
  { TFindThread                                                         }
  {*********************************************************************}
  TFindThread = class(TThread)
  private
    FDirTypeWord: Word;
    FFileTypeWord: Word;
    FFilePattern: TStringList;
    FStartDir: TStringList;
    FFilesFound: TStringList;
    FRecursive: Boolean;
    FMatch: TMatch;
    FMatchCaseSensitive: Boolean;
    FMatchEnabled: Boolean;
    FMatchString: String;
   protected
    procedure Execute; override;
    procedure SearchTree(AFilePattern: String);
  public
    constructor Create(AStartDir: TStringList; AFilePattern: TStringList;
                       AFilesFound: TStringList; ARecursive: Boolean; AMatch: TMatch;
                       AMatchCaseSensitive: Boolean;AMatchEnabled: Boolean;
                       AMatchString: String;AFileTypeWord: Word;ADirTypeWord: Word);
  end;

const
  FileAttributes: array[TFileAttr] of Word = (faReadOnly, faHidden, faSysFile,
     faVolumeID, faDirectory, faArchive, 0);
  DirAttributes: array[TFileAttr] of Word = (faReadOnly, faHidden, faSysFile,
     faVolumeID, faDirectory, faArchive, 0);
  { French Messages }
  MSG_TOO_MUCH_FILES = 'Trop de fichiers.';
  { English Messages }
  {MSG_TOO_MUCH_FILES = 'Too much files.';}

procedure Register;

implementation

{*********************************************************************}
{ procedure Register                                                  }
{*********************************************************************}
procedure Register;
begin
  RegisterComponents('Exemples', [TFileFind]);
end; {Register}

{*********************************************************************}
{ Composant TFileFind                                                 }
{*********************************************************************}

{*********************************************************************}
{ constructor TFileFind.Create                                        }
{*********************************************************************}
constructor TFileFind.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFilePattern := TStringList.Create;
  FFilesFound := TStringList.Create;
  FStartDir := TStringList.Create;
  FConvert := TBrkApart.Create(Self);
  FConvert.BreakString := ';';
  FMatch := TMatch.Create(Self);
  FMatch.SourceIsFile := true;
  FRecursive := true;
  FDirType := [ftDirectory];
  FFileType := [ftNormal];
end; {TFileFind.Create}

{*********************************************************************}
{ destructor TFileFind.Destroy                                        }
{*********************************************************************}
destructor TFileFind.Destroy;
begin
  FFilePattern.Free;
  FFilesFound.Free;
  FStartDir.Free;
  FConvert.Free;
  FMatch.Free;
  inherited Destroy;
end; {TFileFind.Destroy}

{*********************************************************************}
{ procedure TFileFind.SetFileType                                     }
{*********************************************************************}
procedure TFileFind.SetFileType(NewFileType: TFileType);
var
  AttrIndex: TFileAttr;
begin
  if NewFileType <> FFileType then
  begin
   FFileType := NewFileType;
   FFileTypeWord := DDL_READWRITE;
   { Set attribute flags based on values in FileType }
   for AttrIndex := ftReadOnly to ftArchive do
    if AttrIndex in FileType then
       FFileTypeWord := FFileTypeWord or FileAttributes[AttrIndex];
  end;
end;

{*********************************************************************}
{ procedure TFileFind.SetDirType                                      }
{*********************************************************************}
procedure TFileFind.SetDirType(NewDirType: TFileType);
var
  AttrIndex: TFileAttr;
begin
  if NewDirType <> FDirType then
  begin
   FDirType := NewDirType;
   FDirTypeWord := DDL_READWRITE;
   { Set attribute flags based on values in FileType }
   for AttrIndex := ftReadOnly to ftArchive do
    if AttrIndex in DirType then
       FDirTypeWord := FDirTypeWord or DirAttributes[AttrIndex];
  end;
end;

{*********************************************************************}
{ function TFileFind.GetFilePattern                                   }
{*********************************************************************}
function TFileFind.GetFilePattern: String;
begin
  FConvert.StringList.Assign(FFilePattern);
  FConvert.ReverseBreakApart;
  Result := FConvert.BaseString;
end; {TFileFind.GetFilePattern}