findfile.pas

delphi开发的文件搜索组件。 速度极快。

            end;
            PrvChar := BufferPtr^;
            Inc(BufferPtr);
            Dec(SearchCount);
          end;
          SearchCount := Stream.Read(Buffer^, BufferSize);
        end;
      finally
        FreeMem(Buffer, BufferSize);
      end;
    end;
  finally
    Stream.Free;
  end;
end;

function FileContains(const FileName: String; const Phrase: String;
  IgnoreCase, WholeWord: Boolean): Boolean;
begin
  if IgnoreCase then
    Result := FileContainsPhrase(FileName, PChar(AnsiLowerCase(Phrase)),
      Length(Phrase), LowerCharMap, WholeWord)
  else
    Result := FileContainsPhrase(FileName, PChar(Phrase),
      Length(Phrase), NormalCharMap, WholeWord);
end;

function AnsiLowCase(C: Char): Char;
begin
  Result := C;
  CharLowerBuff(@Result, 1);
end;

function StrMatches(const Str, Mask: String): Boolean;
var
  S, M: PChar;
begin
  Result := True;
  S := PChar(Str);
  M := PChar(Mask);
  while (S^ <> #0) and (M^ <> #0) do
  begin
    case M^ of
      '*': Exit;
      '?': ;
    else
      if AnsiLowCase(M^) <> AnsiLowCase(S^) then
      begin
        Result := False;
        Exit;
      end;
    end;
    Inc(S);
    Inc(M);
  end;
  if S^ = #0 then
  begin
    while M^ in ['*', '?'] do
      Inc(M);
    Result := (M^ = #0);
  end
  else
    Result := False;
end;

function FileNameMatches(const FileName, Mask: String): Boolean;
var
  fName, fExt: String;
  mName, mExt: String;
begin
  fName := ChangeFileExt(FileName, '');
  fExt := ExtractFileExt(FileName);
  mName := ChangeFileExt(Mask, '');
  mExt := ExtractFileExt(Mask);
  if Length(mExt) > 0 then
  begin
    if fExt = '' then fExt := '.';
    Result := StrMatches(fExt, mExt) and StrMatches(fName, mName);
  end
  else
    Result := StrMatches(fName, mName);
end;

function DriveMatches(const Drive, Mask: String): Boolean;
begin
  if Pos('\\', Mask) = 1 then
    Result := StrMatches(Drive, Mask)
  else
    Result := (Mask[1] in ['*', '?']) or
              ((Drive <> '') and (AnsiLowCase(Drive[1]) = AnsiLowCase(Drive[1])));
end;

function FileFullPathMatches(const FileDir, FileName, Mask: String): Boolean;
var
  MaskDrive, MaskDir, MaskName: String;
  MaskDirLen: Integer;
  FileDrive, InnerestSubDir: String;
  FileDirLen: Integer;
begin
  Result := False;
  MaskDir := ExtractFilePath(Mask);
  // Checkes part if mask contains path
  if MaskDir <> '' then
  begin
    FileDrive := ExtractFileDrive(FileDir);
    MaskDrive := ExtractFileDrive(MaskDir);
    // Checkes drive if mask contains drive
    if MaskDrive <> '' then
    begin
      if not DriveMatches(FileDrive, MaskDrive) then
        Exit; // Not Matched, drives are different
      // Removes drive from the Mask
      Delete(MaskDir, 1, Length(MaskDrive));
    end;
    // Checkes directory if mask contains directory
    if MaskDir <> '' then
    begin
      MaskDirLen := Length(MaskDir);
      FileDirLen := Length(FileDir);
      if MaskDirLen > FileDirLen - Length(FileDrive) then
        Exit // Not Matched, Mask's length is longer than folder's length
      else
      begin
        // Checkes most inner sub directories
        InnerestSubDir := Copy(FileDir, FileDirLen - MaskDirLen + 1, MaskDirLen);
        if CompareText(InnerestSubDir, MaskDir) <> 0 then
          Exit; // Not Matched
      end;
    end;
  end;
  // Checkes file name part if mask contains filename
  MaskName := ExtractFileName(Mask);
  if MaskName <> '' then
    Result := FileNameMatches(FileName, MaskName)
  else
    Result := True; // Matched
end;

{ TFileCriteria }

constructor TFileCriteria.Create;
begin
  inherited Create;
  fIncluded := TStringList.Create;
  fExcluded := TStringList.Create;
  fSubfolders := True;
end;

destructor TFileCriteria.Destroy;
begin
  fIncluded.Free;
  fExcluded.Free;
  inherited Destroy;
end;

procedure TFileCriteria.Assign(Source: TPersistent);
begin
  if Source is TFileCriteria then
  begin
    Filename := TFileCriteria(Source).FileName;
    Location := TFileCriteria(Source).Location;
    Included := TFileCriteria(Source).Included;
    Excluded := TFileCriteria(Source).Excluded;
    Subfolders := TFileCriteria(Source).Subfolders;
    MinLevel := TFileCriteria(Source).MinLevel;
    MaxLevel := TFileCriteria(Source).MaxLevel;
  end
  else
    inherited Assign(Source);
end;

procedure TFileCriteria.SetIncluded(Value: TStringList);
begin
  fIncluded.Assign(Value);
end;

procedure TFileCriteria.SetExcluded(Value: TStringList);
begin
  fExcluded.Assign(Value);
end;

{ TAttributeCriteria }

constructor TAttributeCriteria.Create;
begin
  inherited Create;
  fFlags := faArchive or faReadonly or faHidden or faSysFile;
  fExactMatch := False;
end;

procedure TAttributeCriteria.Assign(Source: TPersistent);
begin
  if Source is TAttributeCriteria then
  begin
    Flags := TAttributeCriteria(Source).Flags;
    ExactMatch := TAttributeCriteria(Source).ExactMatch;
  end
  else
    inherited Assign(Source);
end;

function TAttributeCriteria.GetAttributes: TFileAttributes;
begin
  Result := [];
  if (Flags and faArchive) = faArchive then
    Include(Result, ffArchive);
  if (Flags and faReadonly) = faReadonly then
    Include(Result, ffReadonly);
  if (Flags and faHidden) = faHidden then
    Include(Result, ffHidden);
  if (Flags and faSysFile) = faSysFile then
    Include(Result, ffSystem);
  if (Flags and faDirectory) = faDirectory then
    Include(Result, ffDirectory);
end;

procedure TAttributeCriteria.SetAttributes(Value: TFileAttributes);
var
  NewFlags: Integer;
begin
  NewFlags := 0;
  if ffArchive in Value then
    NewFlags := NewFlags or faArchive;
  if ffReadonly in Value then
    NewFlags := NewFlags or faReadonly;
  if ffHidden in Value then
    NewFlags := NewFlags or faHidden;
  if ffSystem in Value then
    NewFlags := NewFlags or faSysFile;
  if ffDirectory in Value then
    NewFlags := NewFlags or faDirectory;
  Flags := NewFlags;
end;

function TAttributeCriteria.Matches(Attr: Integer): Boolean;
begin
  Attr := Attr and ValidFileAttr;
  if ExactMatch then
    Result := (Flags = Attr)
  else
    Result := ((not Flags and Attr) = 0);
end;

{ TAttributeCriteriaEx }

constructor TAttributeCriteriaEx.Create;
begin
  inherited Create;
  fSetFlags := 0;
  fUnsetFlags := 0;
end;

procedure TAttributeCriteriaEx.Assign(Source: TPersistent);
begin
  if Source is TAttributeCriteriaEx then
  begin
    fSetFlags := TAttributeCriteriaEx(Source).fSetFlags;
    fUnsetFlags := TAttributeCriteriaEx(Source).fUnsetFlags;
  end
  else
    inherited Assign(Source);
end;

function TAttributeCriteriaEx.Matches(Attr: DWORD): Boolean;
begin
  Result := ((Attr and fSetFlags) = fSetFlags)
        and ((not Attr and fUnsetFlags) = fUnsetFlags);
end;

function TAttributeCriteriaEx.GetAttribute(Index: Integer): TFileAttributeStatus;
var
  Flag: DWORD;
begin
  Flag := FileAttributesEx[Index];
  if LongBool(Flag and fSetFlags) then
    Result := fsSet
  else if LongBool(Flag and fUnsetFlags) then
    Result := fsUnset
  else
    Result := fsIgnore;
end;

procedure TAttributeCriteriaEx.SetAttribute(Index: Integer; Value: TFileAttributeStatus);
var
  Flag: DWORD;
begin
  Flag := FileAttributesEx[Index];
  fSetFlags := fSetFlags and not Flag;
  fUnsetFlags := fUnsetFlags and not Flag;
  case Value of
    fsSet: fSetFlags := fSetFlags or Flag;
    fsUnset: fUnsetFlags := fUnsetFlags or Flag;
  end;
end;

{ TDateTimeCriteria }

procedure TDateTimeCriteria.Assign(Source: TPersistent);
begin
  if Source is TDateTimeCriteria then
  begin
    CreatedBefore := TDateTimeCriteria(Source).CreatedBefore;
    CreatedAfter := TDateTimeCriteria(Source).CreatedAfter;
    ModifiedBefore := TDateTimeCriteria(Source).ModifiedBefore;
    ModifiedAfter := TDateTimeCriteria(Source).ModifiedAfter;
    AccessedBefore := TDateTimeCriteria(Source).AccessedBefore;
    AccessedAfter := TDateTimeCriteria(Source).AccessedAfter;
  end
  else
    inherited Assign(Source);
end;

function TDateTimeCriteria.Matches(const Created, Modified, Accessed: TFileTime): Boolean;
var
  DateTime: TDateTime;
begin
  Result := False;
  if (CreatedBefore <> 0) or (CreatedAfter <> 0) then
  begin
    DateTime := FileTimeToDateTime(Created);
    if not IsDateBetween(DateTime, CreatedBefore, CreatedAfter) then Exit;
  end;
  if (ModifiedBefore <> 0) or (ModifiedAfter <> 0) then
  begin
    DateTime := FileTimeToDateTime(Modified);
    if not IsDateBetween(DateTime, ModifiedBefore, ModifiedAfter) then Exit;
  end;
  if (AccessedBefore <> 0) or (AccessedAfter <> 0) then
  begin
    DateTime := FileTimeToDateTime(Accessed);
    if not IsDateBetween(DateTime, AccessedBefore, AccessedAfter) then Exit;
  end;
  Result := True;
end;

{ TSizeCriteria }

procedure TSizeCriteria.Assign(Source: TPersistent);
begin
  if Source is TSizeCriteria then
  begin
    Min := TSizeCriteria(Source).Min;
    Max := TSizeCriteria(Source).Max;
  end
  else
    inherited Assign(Source);
end;

function TSizeCriteria.Matches(const Size: TFileSize): Boolean;
begin
  Result := ((Min = 0) or (Size >= Min)) and ((Max = 0) or (Size <= Max));
end;

{ TContentCriteria }

constructor TContentCriteria.Create;
begin
  inherited Create;
  fIgnoreCase := True;
  fCharMap := @LowerCharMap;
end;

procedure TContentCriteria.Assign(Source: TPersistent);
begin
  if Source is TContentCriteria then
  begin
    Phrase := TContentCriteria(Source).Phrase;
    IgnoreCase := TContentCriteria(Source).IgnoreCase;
    WholeWord := TContentCriteria(Source).WholeWord;
  end
  else
    inherited Assign(Source);
end;

procedure TContentCriteria.SetPhrase(const Value: String);
begin
  if Phrase <> Value then
  begin
    fPhrase := Value;
    fPhraseLen := Length(Value);
    if IgnoreCase then
      fTargetPhrase := AnsiLowerCase(Phrase)
    else
      fTargetPhrase := Phrase;
  end;
end;

procedure TContentCriteria.SetIgnoreCase(Value: Boolean);
begin
  if IgnoreCase <> Value then
  begin
    fIgnoreCase := Value;
    if IgnoreCase then
    begin
      fTargetPhrase := AnsiLowerCase(Phrase);
      fCharMap := @LowerCharMap;
    end
    else
    begin
      fTargetPhrase := Phrase;
      fCharMap := @NormalCharMap;
    end
  end;
end;

function TContentCriteria.Matches(const FileName: String): Boolean;
begin
  if PhraseLen > 0 then
    try
      Result := FileContainsPhrase(FileName, PChar(TargetPhrase), PhraseLen,
                                   CharMap^, WholeWord);
    except
      Result := False;
    end
  else
    Result := True;
end;

{ TSearchCriteria }

constructor TSearchCriteria.Create;
begin
  inherited Create;
  fFiles := TFileCriteria.Create;
  fAttribute := TAttributeCriteria.Create;
  fAttributeEx := TAttributeCriteriaEx.Create;
  fTimeStamp := TDateTimeCriteria.Create;
  fSize := TSizeCriteria.Create;
  fContent := TContentCriteria.Create;
end;

destructor TSearchCriteria.Destroy;
begin
  fFiles.Free;
  fAttribute.Free;
  fAttributeEx.Free;
  fTimeStamp.Free;
  fSize.Free;
  fContent.Free;
  inherited Destroy;
end;

procedure TSearchCriteria.Assign(Source: TPersistent);
begin
  if Source is TSearchCriteria then
  begin
    Files := TSearchCriteria(Source).Files;
    Attribute := TSearchCriteria(Source).Attribute;
    AttributeEx := TSearchCriteria(Source).AttributeEx;
    TimeStamp := TSearchCriteria(Source).TimeStamp;
    Size := TSearchCriteria(Source).Size;
    Content := TSearchCriteria(Source).Content;
  end
  else
    inherited Assign(Source);
end;

procedure TSearchCriteria.SetFiles(Value: TFileCriteria);
begin
  Files.Assign(Value);
end;

procedure TSearchCriteria.SetAttribute(Value: TAttributeCriteria);
begin
  Attribute.Assign(Value);
end;

procedure TSearchCriteria.SetAttributeEx(Value: TAttributeCriteriaEx);
begin
  AttributeEx.Assign(Value);
end;

procedure TSearchCriteria.SetTimeStamp(Value: TDateTimeCriteria);
begin
  TimeStamp.Assign(Value);
end;

procedure TSearchCriteria.SetSize(Value: TSizeCriteria);
begin
  Size.Assign(Value);
end;

procedure TSearchCriteria.SetContent(Value: TContentCriteria);
begin
  Content.Assign(Value);
end;

{ TTargetFolder }

constructor TTargetFolder.Create;
begin
  inherited Create;
  fFileMasks := TStringList.Create;