jvsearchfiles.pas

East make Tray Icon in delphi

  FDirectories.Free;
  FFileParams.Free;
  FDirParams.Free;
  inherited Destroy;
end;

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