mainunit.pas
上传用户:psxgmh
上传日期:2013-04-08
资源大小:15112k
文件大小:4k
源码类别:

Delphi/CppBuilder

开发平台:

Delphi

  1. unit mainunit;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5.   Dialogs, StdCtrls, Buttons,FileCtrl;
  6. type
  7.   TForm1 = class(TForm)
  8.     Memo1: TMemo;
  9.     Label1: TLabel;
  10.     Label2: TLabel;
  11.     ComboBox1: TComboBox;
  12.     Edit1: TEdit;
  13.     BitBtn1: TBitBtn;
  14.     BitBtn2: TBitBtn;
  15.     BitBtn3: TBitBtn;
  16.     Label3: TLabel;
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure ComboBox1Change(Sender: TObject);
  19.     procedure Edit1Change(Sender: TObject);
  20.     procedure BitBtn1Click(Sender: TObject);
  21.     procedure BitBtn2Click(Sender: TObject);
  22.     procedure BitBtn3Click(Sender: TObject);
  23.   private
  24.     { Private declarations }
  25.   public
  26.     function CurrentIsValidDir(SearchRec:TSearchRec):integer;
  27.     procedure RecurSearchFile(CurrentDir:string;SearchFileType:string;SearchResult:TStrings;var Number:integer);
  28.     { Public declarations }
  29.   end;
  30. var
  31.   Form1: TForm1;
  32.   TotalFileNumbers:Integer;
  33.   SearchFileType:String;
  34. implementation
  35. {$R *.dfm}
  36. procedure TForm1.FormCreate(Sender: TObject);
  37. begin
  38.  TotalFileNumbers:=0;
  39.  SearchFileType:='*.txt';
  40. end;
  41. function TForm1.CurrentIsValidDir(SearchRec:TSearchRec):integer;
  42. begin
  43. if ((SearchRec.Attr <> 16) and
  44.     (SearchRec.Name<>'.')  and
  45.     (SearchRec.Name<>'..')) then
  46.   Result:=0
  47.   else if ((SearchRec.Attr = 16) and
  48.            (SearchRec.Name<>'.') and
  49.            (SearchRec.Name<>'..')) then
  50.   Result:=1
  51.   else
  52.   Result:=2;
  53. end;
  54. Procedure TForm1.RecurSearchFile(CurrentDir:string;SearchFileType:string;SearchResult:TStrings;var Number:integer);
  55. var
  56.  i:integer;
  57.  Subdir:TStringList;
  58.  SearchRec:TsearchRec;
  59. begin
  60. //第一次调用FindFirst和FindNext查找符合要求的文件
  61.  if (FindFirst(CurrentDir+SearchFileType, faAnyFile, SearchRec)=0) then
  62.   begin
  63.    repeat
  64.     if CurrentIsValidDir(SearchRec)=0 then
  65.       begin
  66.        Inc(Number);
  67.        Searchresult.Add(CurrentDir+SearchRec.Name);
  68.       end;
  69.     application.ProcessMessages ;
  70.    until (FindNext(SearchRec) <> 0);
  71.   end;
  72.  FindClose(SearchRec);
  73. //以下是递归部分,查找各子目录。
  74.  Subdir:=TStringList.Create;
  75.  if (FindFirst(CurrentDir+'*.*', faDirectory, SearchRec)=0) then
  76.   begin
  77.    repeat
  78.     if CurrentIsValidDir(SearchRec)=1 then
  79.      begin
  80.       Subdir.Add(SearchRec.Name);
  81.      end;
  82.     application.ProcessMessages ;
  83.    until (FindNext(SearchRec) <> 0);
  84.   end;
  85.  FindClose(SearchRec);
  86.  for i:=0 to Subdir.Count-1 do
  87.   begin
  88.    RecurSearchfile(CurrentDir+Subdir.Strings[i]+'',SearchFileType,Searchresult,Number);
  89.   end;
  90. //资源释放并返回结果。
  91.  Subdir.Free;
  92. end;
  93. procedure TForm1.ComboBox1Change(Sender: TObject);
  94. begin
  95.  Case ComboBox1.ItemIndex of
  96.   0:SearchFileType:='*.txt';
  97.   1:SearchFileType:='*.bmp';
  98.   2:SearchFileType:='*.mp3';
  99.   3:SearchFileType:='*.*';
  100.  end;
  101. end;
  102. procedure TForm1.Edit1Change(Sender: TObject);
  103. begin
  104.  if Edit1.Text='' then
  105.   BitBtn2.Enabled:=False
  106.  else
  107.   BitBtn2.Enabled:=True; 
  108. end;
  109. procedure TForm1.BitBtn1Click(Sender: TObject);
  110. var
  111.  SelectDir:string;
  112. begin
  113.  if SelectDirectory(SelectDir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then
  114.   begin
  115.    if length(SelectDir) > 3 then
  116.     SelectDir:=SelectDir+'';
  117.    Edit1.Text:=SelectDir;
  118.   end;
  119. end;
  120. procedure TForm1.BitBtn2Click(Sender: TObject);
  121. begin
  122.  memo1.lines.Clear ;
  123.  TotalFileNumbers:=0;
  124.  RecurSearchFile(Edit1.Text,SearchFileType,memo1.lines, TotalFileNumbers);
  125.  Label3.Caption:='查找结果显示:'+'一共在当前目录下找到'+IntToStr(TotalFileNumbers)+'个'+SearchFileType+'类型的文件';
  126. end;
  127. procedure TForm1.BitBtn3Click(Sender: TObject);
  128. begin
  129.  Close;
  130. end;
  131. end.