unit1.~pas

很不错文件搜索

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, StrUtils,ComCtrls, ExtCtrls, Buttons,  OleServer,
  ShellApi, Menus,shlobj, jpeg, Unit3;
  //ComObj：com对象调用；shlobj:系统对象的调用
const WM_ThreadDoneMsg=WM_User+8;
type
   PMyRec=^MyRec;
   MyRec=record
     Dirstr:string;
     next:PMyRec;
   end;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ListView1: TListView;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    D1: TMenuItem;
    StatusBar1: TStatusBar;
    Panel2: TPanel;
    Label3: TLabel;
    ComboBox1: TComboBox;
    Button2: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    Label4: TLabel;
    Label5: TLabel;
    Panel3: TPanel;
    Label6: TLabel;
    P1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);

    procedure D1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Label5MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure P1Click(Sender: TObject);
    
  private
    { Private declarations }
    SearchTds1:TSearchThds;
    SearchTds2:TSearchThds;
    SearchTds3:TSearchThds;
    //procedure WMNChitTest(var Msg:TWMNChitTest);
   // Message   WM_NCHITTEST;
    procedure ThreadDone(var AMessage:TMessage);
    Message WM_ThreadDoneMsg;
    procedure InstallThds(TdsActive:boolean;LSearchThd:TSearchThds);
  public
    { Public declarations }
    ThdStop:boolean;
    Drivelist: TStrings;   //驱动器列表
    //finished:boolean;
    DirInfs:PMyRec;
    DirInfs2:PMyRec;
    SearchTotal:integer;

    SearchTds1Active:boolean;
    SearchTds2Active:boolean;
    SearchTds3Active:boolean;

    //procedure CreateParams(var Params:TCreateParams); override;

    procedure GetsystemLogicalDrivesInfo;
    procedure RecurSearchFile(CurrentDir: string; SearchFileType:string;LDirCase:integer);
    function  GetCurrentDriveType(DriveNumber: Pchar):Boolean;
    //function ToReadWordFile(FileName:string):Boolean;
    procedure SearchFileFound(FileFound: TSearchRec;FilePath: string);
    function  andx(str1:string;str2:string):integer;
    function ToSearchWord(FileNames:string;str:WideString):Boolean;
    //字符串分割
    function SplitString(const source,ch:string):TStringList;
    //function IsIncShiTiHao(FileNameStr:string;TeStrArry:TStrings):Boolean;
    function MatchStrings(source, pattern: String): Boolean;
    procedure  CreateDirInfs(var top:PMyRec);
    procedure PushDirInfs(var top:PMyRec;DirStr:string);
    procedure  PopDirInfs(var top:PMyRec;var Dirstr:string);
    procedure  ClearDirInfs(var top:PMyRec);

  end;

var
  Form1: TForm1;
  ShiTiHao: string;
  KeyWord: WideString;
  IntCase: integer;
  //StrArry :TStrings;
  ThreadsNumber:integer;
implementation

uses ComObj, Unit2;
{$R *.dfm}

 //获的驱动器类型
function TForm1.GetCurrentDriveType(DriveNumber:Pchar):Boolean;
var
  DriveType: WORD;  //定义驱动器类型变量。
begin
  DriveType:=Windows.GetDriveType(DriveNumber);
  if DriveType=DRIVE_FIXED then
    result:=True
  else
    result:=False;
end;
 //获得硬盘列表
procedure TForm1.GetsystemLogicalDrivesInfo;
var
  LocalDrives: set of 0..25;
  DriveNumber: Integer;
  Drives: string;

begin
  Drives:='';
  DWORD(LocalDrives):= Windows.GetLogicalDrives;
  for DriveNumber:=0 to 25 do
    begin
      if (DriveNumber in LocalDrives) and (GetCurrentDriveType(PChar(Chr(DriveNumber+Ord('A'))+':\'))) then
        begin
          DriveList.Add(chr(DriveNumber+Ord('A'))+':\');
          Drives:=Drives+Chr(DriveNumber+Ord('A'))+':\';
          ComboBox1.Items.Add(Chr(DriveNumber+Ord('A'))+':\');
        end;
    end;
  ComboBox1.Items.Add('驱动器  '+'('+Drives+')');
  ComboBox1.ItemIndex:=ComboBox1.Items.Count-1;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Drivelist:=TStringList.Create;

  //StrArry:=TStringList.Create;
  GetsystemLogicalDrivesInfo;
  ThdStop:=False;//////////////////
  
  BitBtn2.Enabled:=False;
  SearchTds1Active:=false;
  SearchTds2Active:=false;
  SearchTds3Active:=false;
  ThreadsNumber:=0;
  DirInfs:=nil;
  DirInfs2:=nil;

end;
 //word文档的内部查找
function TForm1.ToSearchWord(FileNames:string;str:WideString):Boolean;
var
  strs: WideString;
  WordApp,WordDoc,vRange: Variant;
  Found: Boolean;
begin

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

   WordApp.Visible:=false;

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

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




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

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

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

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

end;


 //文件搜索
procedure TForm1.RecurSearchFile(CurrentDir:string;SearchFileType:string;LDirCase:integer);
var

  SearchRec:TSearchRec;
  Err:integer;
  FileExt:string;
  DirNumbers:integer;
begin
  //if NoStop then
  //begin
  DirNumbers:=0;
  Err:=FindFirst(CurrentDir+SearchFileType,$35,SearchRec);
 // FileExt:=ExtractFileExt(SearchRec.Name);
  while (Err=0) do
    begin
      if ThdStop then
        Break;
      if SearchRec.Name[1]<>'.' then
        begin
          if (SearchRec.Attr and faDirectory)=0 then
            begin
              StatusBar1.SimpleText:=CurrentDir+SearchRec.Name;
              FileExt:=ExtractFileExt(SearchRec.Name);
              Case IntCase of
              0:  SearchFileFound(SearchRec,CurrentDir);
              1:  if FileExt='.doc' then
                    if ToSearchWord(CurrentDir+SearchRec.Name,KeyWord) then
                       SearchFileFound(SearchRec,CurrentDir);
              2:  if FileExt='.doc' then
                    if  MatchStrings(SearchRec.Name,ShiTiHao) then
                      if ToSearchWord(CurrentDir+SearchRec.Name,KeyWord) then
                        SearchFileFound(SearchRec,CurrentDir);
              3:  if MatchStrings(SearchRec.Name,ShiTiHao) then
                     SearchFileFound(SearchRec,CurrentDir);
              end;
            end;
        end;
      if ((SearchRec.Attr and faDirectory)<>0) and (SearchRec.Name[1]<>'.') then
         begin
         case LDirCase of
           0:PushDirInfs(DirInfs,CurrentDir+SearchRec.Name+'\');
           1:PushDirInfs(DirInfs2,CurrentDir+SearchRec.Name+'\');
         end;
           //curSearchFile(CurrentDir+SearchRec.Name+'\','*.*',ShiTiHao,KeyWord,IntCase);
           //Dir('..');
         end;
      application.ProcessMessages;     //系统消息
      Err:=FindNext(SearchRec);
    end;
  //end
 // else


end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  Ok:  Boolean;
  j:   Integer;
  
  lDirStr:string;
begin
  Ok:=True;
  if Trim(ComboBox1.Text)='' then
    begin
      MessageBox(Handle, '你必须选择搜索路径!', 'ERROR', MB_OK);
      Ok := False;
      Edit1.SetFocus;
    end;
if Ok=True then
  begin
    ListView1.SortType:=stNone;
    BitBtn1.Enabled:=False;

    ThdStop:=False;                     //查询停止条件的负值
    BitBtn2.Enabled:=True;            //停止按钮
    if (Trim(edit1.Text)='') then
      ShiTiHao := Trim(Edit1.Text)               //题根序号
    else
      ShiTiHao := '*'+Trim(Edit1.Text);
    //if ShiTiHao<>'' then
       //StrArry:=SplitString(ShiTiHao,' ');
    KeyWord := WideString(Trim(Edit2.Text));    //参考条件

    IntCase:=andx(ShiTiHao,KeyWord);  //查询条件的关系
    ThreadsNumber:=0;
    SearchTotal:=0;
    //if(DirInfs<>nil)then
       ClearDirInfs(DirInfs);
    //CreateDirInfs(DirInfs);
    //if(DirInfs2<>nil)then
       ClearDirInfs(DirInfs2);
    //CreateDirInfs(DirInfs2);

    ListView1.Clear; //将列表淸空

    if(ComboBox1.ItemIndex=ComboBox1.Items.Count-1) then
      for j:=0 to DriveList.Count-1 do
         //showmessage(Trim(DriveList.Strings[j]))
        RecurSearchFile(Trim(DriveList.Strings[j]),'*.*',0)
    else
      //showmessage(Trim(ComboBox1.Text));
       RecurSearchFile(Trim(ComboBox1.Text),'*.*',0);
  end;
  if (DirInfs<>nil) then
  begin
     while(DirInfs<>nil)do
     begin
       PopDirInfs(DirInfs,lDirStr);
       RecurSearchFile(lDirStr,'*.*',1);
     end;
     if (DirInfs2<>nil) then
     begin
       InstallThds(SearchTds1Active,SearchTds1);
       InstallThds(SearchTds2Active,SearchTds2);
       InstallThds(SearchTds3Active,SearchTds3);
     end
     else
     begin
       BitBtn2.Enabled:=False;
       BitBtn1.Enabled:=True;
       StatusBar1.SimpleText:='  共搜索到 '+inttostr(SearchTotal)+' 个文件';
       ShowMessage('搜索完毕');
     end;
  end
  else
  begin
    BitBtn2.Enabled:=False;
    BitBtn1.Enabled:=True;
    StatusBar1.SimpleText:='  共搜索到 '+inttostr(SearchTotal)+' 个文件';
    ShowMessage('搜索完毕');
  end;
end;

procedure TForm1.SearchFileFound(FileFound: TSearchRec;FilePath: string);
var
  NewItem : TListItem;