unit FileScanner;{v0.28}

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;
    property MatchAttr: longint read FMatchAttr write FMatchAttr;
    property Dir: string read FDir write SetDir;
    property Mask: string read FMask write FMask;
    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;

{v0.35}
{v0.39 moved to winutl}{/v0.39
function DelBackSlash(Dir : string) : string;
function AddBackSlash(Dir : string): string;
function CheckDirExists(const Dir: string): boolean;}
  { Check if the directory exists, if not, creates it (and all subdirs).
    Returns false if not exists and can not create. }
{/v0.35}

implementation

{v0.35}
{Utl}
{v0.39 moved to winutl}{/v0.39
function DelBackSlash(Dir : string) : string;
begin
  if (Length(Dir) > 3) then begin
    if (Dir[Length(Dir)] = '\') then SetLength(Dir, length(Dir) - 1);
  end else begin
    if (Dir[Length(Dir)] = '\') then begin
      if Length(Dir) > 1 then begin
        if (Length(Dir) < 3) or (Dir[2] <> ':') then SetLength(Dir, Length(Dir) - 1);
      end;
    end;
  end;
  Result := Dir;
end;

function AddBackSlash(Dir : string): string;
begin
  if (Dir <>  '') and (Dir[Length(Dir)] <> '\') then begin
    if (Length(Dir) <> 2) or (Dir[2] <> ':') then Dir := Dir + '\';
  end;
  Result := Dir;
end;

function CheckDirExists(const Dir: string): boolean;
var
  i: integer;
begin
  Result := true;
  for i := 1 to length(Dir) do begin
    if Dir[i] = '\' then begin
      if not DirectoryExists(copy(Dir, 1, i - 1)) then begin
        if not CreateDir(copy(Dir, 1, i - 1)) then begin
          Result := false;
          exit;
        end;
      end;
    end;
  end;
end;}
{/Utl}
{/v0.35}

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;
begin
  {aborted := false;}
  {v0.35}
  d := AddBackSlash(ADir);
  FCurMaskSubDir := ExtractFilePath(FMask);
  FCurMask := ExtractFileName(FMask);
  d := d + FCurMaskSubDir;
  {/v0.35
  d := ADir;
  if d <> '' then begin
    if d[Length(d)] <> '\' then begin
      if (Length(d) <> 2) or (d <> ':') then
        d := d + '\';
    end;
  end;}

  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) <> MatchAttr 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;
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.
