unit1.~pas

很不错文件搜索

  OldTime : TDateTime;
  Time    : String;
begin
  Inc(SearchTotal);
  OldTime:=FileDateToDateTime(FileFound.Time);
  Time := DateTimeToStr(OldTime);
  NewItem := ListView1.Items.Add;

  with NewItem do
  begin
    Caption := FileFound.Name;
    SubItems.Add(FilePath);
    SubItems.Add(IntToStr(FileFound.Size));
    SubItems.Add(Time);
  end;

end;

procedure TForm1.ListView1DblClick(Sender: TObject);
var
  FilePathName:string;
begin
  if BitBtn1.Enabled then
  begin
  if ListView1.Selected<> nil then
    with ListView1.Selected do
      begin
        FilePathName:=SubItems.Strings[0]+Caption;
        shellexecute(handle,'open',pchar(FilePathName),nil,nil,SW_SHOWNORMAL);
      end;
  end;
end;
function TForm1.andx(str1:string;str2:string):integer;
begin
  if (str1='') and (str2='') then
     result:=0;
  if (str1='') and (str2<>'') then
     result:=1;
  if (str1<>'') and (str2<>'') then
     result:=2;
  if (str1<>'') and (str2='') then
     result:=3;

end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  ThdStop:=True;

  if (SearchTds1<>nil) and( SearchTds1Active=true) then
  begin
    SearchTds1.Terminate;
    SearchTds1.WaitFor;
  end;
  if (SearchTds2<>nil) and( SearchTds2Active=true) then
  begin
    SearchTds2.Terminate;
    SearchTds2.WaitFor;
  end;
  if (SearchTds3<>nil) and( SearchTds3Active=true) then
  begin
    SearchTds3.Terminate;
    SearchTds3.WaitFor;
  end;
end;



procedure TForm1.D1Click(Sender: TObject);
var
  FilePathName:string;
begin
  if BitBtn1.Enabled then
  begin
  if ListView1.Selected<> nil then
    with ListView1.Selected do
      begin
        FilePathName:=SubItems.Strings[0];
        shellexecute(handle,'explore',pchar(FilePathName),nil,nil,SW_SHOWNORMAL);
      end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Bro        : BROWSEINFO;
  ItemID     : PITEMIDLIST;
  Result     : array[1..MAX_PATH] of Char;
begin
  Bro.hwndOwner      := Handle  ; // Fenetre appelante
  Bro.pidlRoot       := nil     ; // Repertoire de depart
  Bro.pszDisplayName := @Result ; // Resultat de la selection
  Bro.lpszTitle      := '请指定查询路径'; // Titre de la fenetre
  Bro.ulFlags        := 0        ;
  Bro.lpfn           := nil      ; // Fonction 'callback' appele a chaque evenements
  Bro.lParam         := 0        ; // Parametre passe a la fonction 'callback'
  Bro.iImage         := 0        ; // Index de l'image
  { Ouvre la fenetre de parcour }
  ItemID := SHBrowseForFolder(Bro);

  { Si une selection a ete faite }
  if ItemID<>nil then
  begin
    if SHGetPathFromIDList(ItemID, @Result)=True then
      begin
        ComboBox1.ItemIndex:=-1;
        ComboBox1.Text := Result;
        if Length(ComboBox1.Text)>3 then
          ComboBox1.Text:=ComboBox1.Text+'\';
      end;
  end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

  DriveList.Free;
  //StrArry.Free;
  
  if (SearchTds1<>nil) and( SearchTds1Active=true) then
  begin
    SearchTds1.Terminate;
    SearchTds1.WaitFor;
  end;
  if (SearchTds2<>nil) and( SearchTds2Active=true) then
  begin
    SearchTds2.Terminate;
    SearchTds2.WaitFor;
  end;
  if (SearchTds3<>nil) and( SearchTds3Active=true) then
  begin
    SearchTds3.Terminate;
    SearchTds3.WaitFor;
  end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  Form1.Close;
end;
{
procedure TForm1.WMNChitTest(var Msg:TWMNChitTest);
begin
  inherited;
  if Msg.Result=htClient then
    Msg.Result:=htCaption;
end;
 }
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  Form1.Close;
end;
{
procedure TForm1.CreateParams(var Params:TCreateParams);
Begin
  inherited CreateParams(Params);
  Params.Style:=WS_THICkFRAME or WS_POPUP or WS_BORDER;
end;
 }
function TForm1.SplitString(const source,ch:string):TStringList;
var
  temp:string;
  i:integer;
begin
  result:=tstringlist.Create;
  temp:=source;
  i:=pos(ch,source);
  while i<>0 do
  begin
    result.Add(copy(temp,0,i-1));
    delete(temp,1,i);
    temp:=trim(temp);
    i:=pos(ch,temp);
  end;
  result.Add(temp);
end;
{
function TForm1.IsIncShiTiHao(FileNameStr:string;TeStrArry:TStrings):Boolean;
var
  i:integer;
  IsInclude:boolean;
begin
  IsInclude:=true;
  for i:=0 to TeStrArry.Count-1 do
    if (not AnsiContainsText(FileNameStr,TeStrArry.Strings[i])) then
    begin
      IsInclude:=False;
      break;
    end;
  result:=IsInclude;
end;
}
procedure TForm1.InstallThds(TdsActive:boolean;LSearchThd: TSearchThds);
begin
  inc(ThreadsNumber);
  TdsActive:=true;
  LSearchThd:=SearchThd1.CreateIt(ListView1,StatusBar1,ShiTiHao,KeyWord,IntCase);
end;

procedure TForm1.ThreadDone(var AMessage: TMessage);
begin
  dec(ThreadsNumber);
  if ((SearchTds1<>nil) and
     (SearchTds1.ThreadID=cardinal(AMessage.WParam)))then
  begin
    SearchTds1Active:=false;
  end;
  if ((SearchTds2<>nil) and
     (SearchTds2.ThreadID=cardinal(AMessage.WParam)))then
  begin
    SearchTds2Active:=false;
  end;
  if ((SearchTds3<>nil) and
     (SearchTds3.ThreadID=cardinal(AMessage.WParam)))then
  begin
    SearchTds3Active:=false;
  end;
  if ThreadsNumber=0 then
  begin
    BitBtn2.Enabled:=False;
    BitBtn1.Enabled:=True;
    StatusBar1.SimpleText:='  共搜索到 '+inttostr(SearchTotal)+' 个文件';
    ShowMessage('搜索完毕');
  end;
end;


procedure TForm1.CreateDirInfs(var top:PMyRec);
var
  p,head:PMyRec;
begin
  head:=nil;
  new(p);
  p^.Dirstr:='';
  p^.next:=head;
  head:=p;
  top:=head;
end;

procedure TForm1.PushDirInfs(var top: PMyRec; DirStr: string);
var
  p,q:PMyRec;
begin
    if top=nil then
    begin
      CreateDirInfs(top);
    end;
    q:=top;
    if(q^.Dirstr='')then
    q^.Dirstr:=DirStr
    else
    begin
      new(p);
      p^.Dirstr:=DirStr;
      p^.next:=q;
      q:=p;
    end;
    top:=q;
end;

procedure TForm1.PopDirInfs(var top: PMyRec;var DirStr:string);
var
  q,p:PMyRec;
begin
  q:=top;
  p:=top;
  if(p<>nil)then
  begin
    DirStr:=p^.Dirstr;
    q:=p^.next;
    Dispose(p);
    top:=q;
  end;
end;

procedure TForm1.ClearDirInfs(var top: PMyRec);
var
  p,q:PMyRec;
begin
  p:=top;
  q:=top;
  while(p<>nil)do
  begin
    q:=p^.next;
    Dispose(p);
    p:=q;
  end;
  top:=nil;
end;

procedure TForm1.Label5MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  shellexecute(handle,'open','mailto:[e-mail]',nil,nil,SW_SHOWNORMAL);
end;

function TForm1.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;

procedure TForm1.P1Click(Sender: TObject);
begin
  if BitBtn1.Enabled then
    if SearchTotal<>0 then
      ListView1.SortType:=stBoth;
end;

end.