jvqsearchfiles.pas

East make Tray Icon in delphi

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