unit FileScanner;{v0.28}
{ Component that can be used for scanning through files
  in specified directory and its subdirectories. }

{
  (C) 2000 - 2002 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
  {v0.35}{, FileCtrl}{/v0.35}{v0.39}, WinUtl{/v0.39};

type
  TDoDirResult = (drOK, drContinue, drAbort);
    { drContinue - skip this dir
      drAbort - abort the scanning of files }
  TDoFileResult = (frOK, frContinue, frAbort);
    { frContinue - continue on next file (dont scan the file lines),
      frAbort - abort the scanning of files }
  TDoLineResult = (lrOK, lrContinue, lrBreak, lrAbort);
    { lrContinue - continue on next line,
      lrBreak - skip scanning remaining lines
      lrAbort - abort scanning of files }
  TFileNamePart = (fpDir, fpName, fpExt);
  TFileNameParts = set of TFileNamePart;

  TDoFile = procedure(const ADir: string; const ASearchRec: TSearchRec; var AResult: TDoFileResult) of object;
  TDoLine = procedure(const ALine: string; var AResult: TDoLineResult) of object;
  TDoDir = procedure(const ADir: string; var AResult: TDoDirResult) of object;

  TFileScanner = class(TComponent)
  private
    { Private declarations }

    FDir: string;
    FMask: string;
    FDirMask: string;
    FRecursive: boolean;
    FScanText: boolean;
    FScanAttr: longint;
    FMatchAttr: longint;
    FOnDoFile: TDoFile;
    FOnDoLine: TDoLine;
    FOnDoDir: TDoDir;
    { SysUtils:
        faReadOnly	$00000001	Read-only files
        faHidden	$00000002	Hidden files
        faSysFile	$00000004	System files
        faVolumeID	$00000008	Volume ID files
        faDirectory	$00000010	Directory files
        faArchive	$00000020	Archive files
        faAnyFile	$0000003F	Any file
    }
    FFileMatchCount: integer;
      { number of files that matched mask and attr (number of calls of OnDoFile
        event) }
    FFileScanCount: integer;
      { number of files scanned }
    FFileLineCount: integer;
      { count of lines scanned for last file }
    FLineCount: integer;
      { count of all lines (from all files) scanned }
    FProgressForm: TForm;
    FMakeList: boolean;
      { Should the List be filled with matched file names? }
    FListFileNameParts: TFileNameParts;
      { what parts of the matched file name should be included to List
        (if MakeList is true) }
    FList: TStringList;
      { List of found matched files }
    FModifiedAfter: integer;
      { if <> 0, then only files older then this date time are the match }
    FModifiedBefore: integer;
      { if <> 0, then only files younger then this date/time are the match }
    FBiggerThan: integer;
      { if <> 0, then only files of size > BiggerThan are the match }
    FSmallerThan: integer;
      { if <> 0, then only files of size < SmallerThan are the match }
    FAborted: boolean;
    FChangeDirs: boolean;
      { Change current dir to the one that is beeing scanned? }
    FCountingEnabled: boolean;
      { Should the matching files be included in counting/list? }
    {v0.35}
    FCurMaskSubDir: string;
    FCurMask: string;
      { for lib\*.* is FCurMaskSubDir = "lib\", FCurMask = "*.*" }
    {/v0.35}
  protected
    { Protected declarations }
    procedure ScanDir(const ADir: string);
    procedure SetDir(const ADir: string);
    procedure SetOnDoLine(ADoLine: TDoLine);
    function GetList: TStringList;
    procedure SetModifiedAfter(AValue: TDateTime);
    procedure SetModifiedBefore(AValue: TDateTime);
    function GetModifiedAfter: TDateTime;
    function GetModifiedBefore: TDateTime;
    {v0.35}
    procedure SetMakeList(OnOff: boolean);
    {/v0.35}
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
    procedure Scan;
    property List: TStringList read GetList;
  published
    { Published declarations }
    property ScanAttr: longint read FScanAttr write FScanAttr;
    { if MatchAttr <> 0, then file will be included only if MatchAttr and SearchRec.Attr <> 0 }
    property MatchAttr: longint read FMatchAttr write FMatchAttr;
    property Dir: string read FDir write SetDir;
    property Mask: string read FMask write FMask;
    { DirMask is *.* by default meaning that all subdirectories are checked
      if Recursive is set. }
    property DirMask: string read FDirMask write FDirMask;
    property Recursive: boolean read FRecursive write FRecursive;
    property ScanText: boolean read FScanText write FScanText;
    property OnDoFile: TDoFile read FOnDoFile write FOnDoFile;
    property OnDoLine: TDoLine read FOnDoLine write SetOnDoLine;
    property OnDoDir: TDoDir read FOnDoDir write FOnDoDir;
    property MakeList: boolean read FMakeList write SetMakeList;
    property ListFileNameParts: TFileNameParts read FListFileNameParts write FListFileNameParts;
    property ModifiedAfter: TDateTime read GetModifiedAfter write SetModifiedAfter;
    property ModifiedBefore: TDateTime read GetModifiedBefore write SetModifiedBefore;
    property BiggerThan: integer read FBiggerThan write FBiggerThan;
    property SmallerThan: integer read FSmallerThan write FSmallerThan;
    property ChangeDirs: boolean read FChangeDirs write FChangeDirs;
    property CountingEnabled: boolean read FCountingEnabled write FCountingEnabled;
  end;

procedure Register;

implementation


constructor TFileScanner.Create(AOwner: TComponent);
begin
  inherited;
  FMask := '*.*';
  FDirMask := '*.*';{fileu}
  FCountingEnabled := true;
end;

procedure TFileScanner.SetOnDoLine(ADoLine: TDoLine);
begin
  FOnDoLine := ADoLine;
  if Assigned(FOnDoLine) then
    FScanText := true;
end;

procedure TFileScanner.SetDir(const ADir: string);
begin
  FDir := ADir;
  if FDir <> '' then begin
    FDir := DelBackSlash(ADir);
  end;
end;

procedure TFileScanner.ScanDir(const ADir: string);
var
  sr: TSearchRec;
  dr: TDoDirResult;
  fr: TDoFileResult;
  lr: TDoLineResult;
  line: string;
  f: text;
  d: string;
  n: string;

  odir: string;
  {v0.64}
  msk, msks: string;
  {/v0.64}
begin
  {aborted := false;}
  {v0.64}
  msks := FMask;
  while ExtractWord([';'], msk, msks) do begin
  {/v0.64}
    d := AddBackSlash(ADir);
    FCurMaskSubDir := ExtractFilePath({v0.64}msk{/v0.64 FMask});
    FCurMask := ExtractFileName({v0.64}msk{/v0.64 FMask});
    d := d + FCurMaskSubDir;

    if FChangeDirs then begin
      GetDir(0, odir);
      ChDir(d);
    end;

    try
      if Assigned(FOnDoDir) then begin
        dr := drOK;
        FOnDoDir(d, dr);
        case dr of
          drAbort: begin
            FAborted := true;
          end;
          drContinue: begin
            exit;
          end;
        end;
      end;

      if (not FAborted) and (FindFirst(d + {v0.35} FCurMask{/v0.35 FMask}, ScanAttr, sr) = 0) then
      try
        {aborted := false;}
        repeat
          if FCountingEnabled then
            inc(FFileScanCount);

          if (MatchAttr <> 0) then begin
            if (MatchAttr and sr.Attr) = 0{<> 0MatchAttr} then
              continue;
          end;
          if FModifiedAfter <> 0 then begin
            if sr.Time <= FModifiedAfter then
              continue;
          end;
          if FModifiedBefore <> 0 then begin
            if sr.Time >= FModifiedBefore then
              continue;
          end;
          if FSmallerThan <> 0 then begin
            if sr.Size >= FSmallerThan then
              continue;
          end;
          if FBiggerThan <> 0 then begin
            if sr.Size <= FBiggerThan then
              continue;
          end;

          {v0.35}
          if (sr.Name = '.') or (sr.Name = '..') then begin
            continue;
          end;
          {/v0.35}

          if FCountingEnabled then
            inc(FFileMatchCount);
          FFileLineCount := 0;
          if FMakeList and FCountingEnabled then begin
            n := '';
            if fpDir in FListFileNameParts then
              n := {v0.35} d;{ExtractFileName(d);}
            if fpName in FListFileNameParts then begin
              if fpExt in FListFileNameParts then
                n := n + ExtractFileName(sr.Name)
              else
                n := n + ChangeFileExt(ExtractFileName(sr.Name),'');
            end;
            List.Add(n);
          end;
          fr := frOK;
          if Assigned(FOnDoFile) then begin
            FOnDoFile(d, sr, fr);
            case fr of
              frAbort: begin
                FAborted := true;
                break;
              end;
              frContinue: continue;
            end;
          end;
          if FProgressForm <> nil then
            FProgressForm.Caption := d + sr.Name;

          if ((sr.Attr and faDirectory) = 0) then begin
            if ScanText and Assigned(FOnDoLine) then begin
              AssignFile(f, d + sr.Name);
              try
                Reset(f);
                try
                  while not eof(f) do begin
                    Readln(f, line);
                    if FCountingEnabled then begin
                      inc(FLineCount);
                      inc(FFileLineCount);
                    end;
                    lr := lrOK;
                    FOnDoLine(line, lr);
                    case lr of
                      lrBreak: break;
                      lrAbort: begin
                        FAborted := true;
                        break;
                      end;
                    end;
                  end;
                finally
                  CloseFile(F);
                end;
              except
                { ignore file open/close exceptions }
              end;
            end;
          end;
        until FAborted or (FindNext(sr) <> 0);
      finally
        FindClose(sr);
      end;

      if Recursive and (not FAborted) then begin
        if FindFirst(d + FDirMask, faDirectory, sr) = 0 then
        try
          repeat
            if (sr.Name <> '.') and (sr.Name <> '..') then begin
              ScanDir(d + sr.Name);
            end;
          until (not FAborted) or (FindNext(sr) <> 0);
        finally
          FindClose(sr);
        end;
      end;

    finally
      if FChangeDirs then
        ChDir(odir);
    end;
  {v0.64}
  end;
  {/v0.64}
end;

function TFileScanner.GetList: TStringList;
begin
  if FList = nil then
    FList := TStringList.Create;
  Result := FList;
end;

procedure TFileScanner.Scan;
begin
{  if (not Assigned(FOnDoFile)) and (not Assigned(FOnDoLine)) then begin
    raise Exception.Create('FileScanner - no File/Line handlers assigned');
  end;}
  FAborted := false;
  List.Clear;
  FFileMatchCount := 0;
  FFileScanCount := 0;

  FFileLineCount := 0;
  FLineCount := 0;
  {v0.35}
  if (not Assigned(FOnDoFile)) and (not Assigned(FOnDoDir)) and (not Assigned(FOnDoLine)) then
  begin
    MakeList := true;
  end;
  {/v0.35}
  FProgressForm := TForm.Create(Application);
  try
    FProgressForm.Caption := 'Scanning ' + Dir + ' ' + Mask;
    FProgressForm.Show;
    if ScanAttr = 0 then
      ScanAttr := faAnyFile;
    ScanDir(Dir);
  finally
    FProgressForm.Free;
  end;
end;

procedure TFileScanner.SetModifiedAfter(AValue: TDateTime);
begin
  if AValue = 0 then
    FModifiedAfter := 0
  else
    FModifiedAfter := DateTimeToFileDate(AValue);
end;

procedure TFileScanner.SetModifiedBefore(AValue: TDateTime);
begin
  if AValue = 0 then
    FModifiedBefore := 0
  else
    FModifiedBefore := DateTimeToFileDate(AValue);
end;

function TFileScanner.GetModifiedAfter: TDateTime;
begin
  if FModifiedAfter = 0 then
    Result := 0
  else
    Result := FileDateToDateTime(FModifiedAfter);
end;

function TFileScanner.GetModifiedBefore: TDateTime;
begin
  if FModifiedBefore = 0 then
    Result := 0
  else
    Result := FileDateToDateTime(FModifiedBefore);
end;

destructor TFileScanner.Destroy;
begin
  FList.Free;
  inherited;
end;

procedure TFileScanner.SetMakeList(OnOff: boolean);
begin
  if FMakeList <> OnOff then begin
    if OnOff then begin
      if ListFileNameParts = [] then
        ListFileNameParts := [fpDir, fpName, fpExt];
    end;
    FMakeList := OnOff;
  end;
end;

procedure Register;
begin
  RegisterComponents('File Utils', [TFileScanner]);
end;

end.
