unit3.pas

很不错文件搜索

unit Unit3;

interface

uses
  Windows,Classes,ComCtrls,SysUtils, StrUtils,Dialogs,ComObj,Variants;


type
  TSearchThds = class(TThread)
  private
    FListView:TListView;
    FStatusBar:TStatusBar;
    FFileFound: TSearchRec;
    FFilePaths:string;
    FShiTiHao:String;
    FKeyWord:widestring;
    FFullFileName:string;
    FIsIncKeyWord:boolean;
    FIntCase:integer;
    procedure ToDisplayInfs;
    procedure ToDisplayFoundFile;
    { Private declarations }
  protected
    procedure Execute; override;
    procedure ToSearchFile(SearchDirs:string;SearchFileType:string);
    procedure FToSearchWord;
    //function FIsIncShiTiHao(FileNameStr:string):Boolean;
    function MatchStrings(source, pattern: String): Boolean;

  public
    constructor CreateIt(ListViews:TListView;StatusBars:TStatusBar;
    ShiTiHaos:String;KeyWords:wideString;IntCases:integer);//
    Destructor Destroy;override;

  end;


  SearchThd1=Class(TSearchThds);
  SearchThd2=Class(TSearchThds);

implementation

uses Unit1;

{ Important: Methods and properties of objects in VCL or CLX can only be used
  in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure TSearchThds.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ TSearchThds }




constructor TSearchThds.CreateIt(ListViews: TListView;
  StatusBars: TStatusBar;ShiTiHaos:String;KeyWords:wideString;IntCases:integer);
begin

  FListView:=ListViews;
  FStatusBar:=StatusBars;
  FShiTiHao:=ShiTiHaos;
  FKeyWord:=KeyWords;
  FIntCase:=IntCases;

   FreeOnTerminate := True;
   inherited Create(false);

end;

destructor TSearchThds.Destroy;
begin
  PostMessage(Form1.Handle,wm_ThreadDoneMsg,self.ThreadID,0);
  inherited;
end;

procedure TSearchThds.Execute;
var
  i:integer;
  str:string;
begin
   
  while(form1.DirInfs2<>nil)do
  begin
    form1.PopDirInfs(form1.DirInfs2,str);
    ToSearchFile(str,'*.*');
    if form1.ThdStop=True then ////////////////
        break;
  end;

  { Place thread code here }
end;
{
function TSearchThds.FIsIncShiTiHao(FileNameStr: string): Boolean;
var
  i:integer;
  IsInclude:boolean;
begin
  IsInclude:=true;
  for i:=0 to FShiTiHao.Count-1 do
    if (not AnsiContainsText(FileNameStr,FShiTiHao.Strings[i])) then
    begin
      IsInclude:=False;
      break;
    end;
  result:=IsInclude;
end;
}
procedure TSearchThds.ToDisplayFoundFile;
var
  NewItem : TListItem;
  OldTime : TDateTime;
  Time    : String;
begin
  inc(form1.SearchTotal);
  OldTime:=FileDateToDateTime(FFileFound.Time);
  Time := DateTimeToStr(OldTime);
  NewItem := FListView.Items.Add;

  with NewItem do
  begin
    Caption := FFileFound.Name;
    SubItems.Append(FFilePaths);
    SubItems.Append(IntToStr(FFileFound.Size));
    SubItems.Append(Time);
  end;

end;

procedure TSearchThds.ToDisplayInfs;
begin
  FStatusBar.SimpleText:=FFilePaths;
end;

procedure TSearchThds.ToSearchFile(SearchDirs:string;SearchFileType: string);
var
  SearchRec:TSearchRec;
  Err:integer;
  FileExt:string;
begin

  Err:=FindFirst(SearchDirs+SearchFileType,$35,SearchRec);
  while (Err=0) do
    begin
      if form1.ThdStop=True then ////////////////
        break;
      if SearchRec.Name[1]<>'.' then
        begin
          if (SearchRec.Attr and faDirectory)=0 then
            begin
              FFilePaths:=SearchDirs+SearchRec.Name;
              Synchronize(ToDisplayInfs);
              FileExt:=ExtractFileExt(SearchRec.Name);
              Case FIntCase of
              0: begin
                   FFileFound:=SearchRec;
                   FFilePaths:=SearchDirs;
                   Synchronize(ToDisplayFoundFile);
                  end;
              1:  if FileExt='.doc' then
                    begin
                      FFullFileName:=SearchDirs+SearchRec.Name;
                      Synchronize(FToSearchWord);
                      if FIsIncKeyWord=true then
                      begin
                        FFileFound:=SearchRec;
                        FFilePaths:=SearchDirs;
                        Synchronize(ToDisplayFoundFile);
                      end;
                    end;
              2:  if FileExt='.doc' then
                    if  MatchStrings(SearchRec.Name,FShiTiHao) then
                    begin
                      FFullFileName:=SearchDirs+SearchRec.Name;
                      Synchronize(FToSearchWord);
                      if FIsIncKeyWord=true then
                      begin
                        FFileFound:=SearchRec;
                        FFilePaths:=SearchDirs;
                        Synchronize(ToDisplayFoundFile);
                      end;
                    end;
              3:  if MatchStrings(SearchRec.Name,FShiTiHao) then
                  begin
                    FFileFound:=SearchRec;
                    FFilePaths:=SearchDirs;
                    Synchronize(ToDisplayFoundFile);
                  end;

              end;
            end;
        end;
      if ((SearchRec.Attr and faDirectory)<>0) and (SearchRec.Name[1]<>'.') then
         begin
           ToSearchFile(SearchDirs+SearchRec.Name+'\','*.*');
           ChDir('..');
         end;
      Err:=FindNext(SearchRec);
    end;
   
end;

procedure TSearchThds.FToSearchWord;
var
  strs: WideString;
  WordApp,WordDoc,vRange: Variant;
  Found: Boolean;
begin

 try
   strs:=FKeyWord;
   Found:=True;
   try
     WordApp:=CreateOleObject('Word.Application');
   except
     MessageDlg('Word可能没有安装！', mtError, [mbOk], 0);
     FIsIncKeyWord:=False;
     form1.ThdStop:=True ;
     Exit;
   end;

   WordApp.Visible:=false;

  //调用Open函数打开文档
  try
    WordDoc:=WordApp.Documents.Open(FFullFileName);
  except
     FIsIncKeyWord:=False;
     exit;
  end;
   //选取中整个文档
   WordDoc.Select ;

   //查找范围
   vRange := WordDoc.Range ;




///////////////////////////////////////////////////////////////////////

 Found:=WordDoc.Range.Find.Execute(strs,,,,,,,,,,False) ;  

 ///////////////////////////////////////////////////////////////////
 finally
  WordDoc.Close(True) ; //关闭文并保存

  WordApp.Quit(False) ; //退出Word
 end;
 FIsIncKeyWord:=Found;

end;

function TSearchThds.MatchStrings(source, pattern: String): Boolean;
 var
  pSource: Array [0..255] of Char;
  pPattern: Array [0..255] of Char;

  function MatchPattern(element, pattern: PChar): Boolean;
    function IsPatternWild(pattern: PChar): Boolean;
      var
      t: Integer;
    begin
      Result := StrScan(pattern,'*') <> nil;
      if not Result then Result := StrScan(pattern,'?') <> nil;
    end;

  begin
    if 0 = StrComp(pattern,'*') then
      Result := True
    else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
      Result := False
    else if (pattern^ = Chr(0)) then
      Result := True
    else begin
      case pattern^ of
      '*': if MatchPattern(element,@pattern[1]) then
             Result := True
           else
             Result := MatchPattern(@element[1],pattern);
      '?': Result := MatchPattern(@element[1],@pattern[1]);
    else
      if element^ = pattern^ then
          Result := MatchPattern(@element[1],@pattern[1])
      else
          Result := False;
      end;
    end;
  end;

begin
  source:=UpperCase(source);
  pattern:=UpperCase(pattern);
  StrPCopy(pSource,source);
  StrPCopy(pPattern,pattern);
  Result := MatchPattern(pSource,pPattern);
end;


end.