mainunit.pas
上传用户:psxgmh
上传日期:2013-04-08
资源大小:15112k
文件大小:4k
- unit mainunit;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, Buttons,FileCtrl;
- type
- TForm1 = class(TForm)
- Memo1: TMemo;
- Label1: TLabel;
- Label2: TLabel;
- ComboBox1: TComboBox;
- Edit1: TEdit;
- BitBtn1: TBitBtn;
- BitBtn2: TBitBtn;
- BitBtn3: TBitBtn;
- Label3: TLabel;
- procedure FormCreate(Sender: TObject);
- procedure ComboBox1Change(Sender: TObject);
- procedure Edit1Change(Sender: TObject);
- procedure BitBtn1Click(Sender: TObject);
- procedure BitBtn2Click(Sender: TObject);
- procedure BitBtn3Click(Sender: TObject);
- private
- { Private declarations }
- public
- function CurrentIsValidDir(SearchRec:TSearchRec):integer;
- procedure RecurSearchFile(CurrentDir:string;SearchFileType:string;SearchResult:TStrings;var Number:integer);
- { Public declarations }
- end;
- var
- Form1: TForm1;
- TotalFileNumbers:Integer;
- SearchFileType:String;
- implementation
- {$R *.dfm}
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- TotalFileNumbers:=0;
- SearchFileType:='*.txt';
- end;
- function TForm1.CurrentIsValidDir(SearchRec:TSearchRec):integer;
- begin
- if ((SearchRec.Attr <> 16) and
- (SearchRec.Name<>'.') and
- (SearchRec.Name<>'..')) then
- Result:=0
- else if ((SearchRec.Attr = 16) and
- (SearchRec.Name<>'.') and
- (SearchRec.Name<>'..')) then
- Result:=1
- else
- Result:=2;
- end;
- Procedure TForm1.RecurSearchFile(CurrentDir:string;SearchFileType:string;SearchResult:TStrings;var Number:integer);
- var
- i:integer;
- Subdir:TStringList;
- SearchRec:TsearchRec;
- begin
- //第一次调用FindFirst和FindNext查找符合要求的文件
- if (FindFirst(CurrentDir+SearchFileType, faAnyFile, SearchRec)=0) then
- begin
- repeat
- if CurrentIsValidDir(SearchRec)=0 then
- begin
- Inc(Number);
- Searchresult.Add(CurrentDir+SearchRec.Name);
- end;
- application.ProcessMessages ;
- until (FindNext(SearchRec) <> 0);
- end;
- FindClose(SearchRec);
- //以下是递归部分,查找各子目录。
- Subdir:=TStringList.Create;
- if (FindFirst(CurrentDir+'*.*', faDirectory, SearchRec)=0) then
- begin
- repeat
- if CurrentIsValidDir(SearchRec)=1 then
- begin
- Subdir.Add(SearchRec.Name);
- end;
- application.ProcessMessages ;
- until (FindNext(SearchRec) <> 0);
- end;
- FindClose(SearchRec);
- for i:=0 to Subdir.Count-1 do
- begin
- RecurSearchfile(CurrentDir+Subdir.Strings[i]+'',SearchFileType,Searchresult,Number);
- end;
- //资源释放并返回结果。
- Subdir.Free;
- end;
- procedure TForm1.ComboBox1Change(Sender: TObject);
- begin
- Case ComboBox1.ItemIndex of
- 0:SearchFileType:='*.txt';
- 1:SearchFileType:='*.bmp';
- 2:SearchFileType:='*.mp3';
- 3:SearchFileType:='*.*';
- end;
- end;
- procedure TForm1.Edit1Change(Sender: TObject);
- begin
- if Edit1.Text='' then
- BitBtn2.Enabled:=False
- else
- BitBtn2.Enabled:=True;
- end;
- procedure TForm1.BitBtn1Click(Sender: TObject);
- var
- SelectDir:string;
- begin
- if SelectDirectory(SelectDir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then
- begin
- if length(SelectDir) > 3 then
- SelectDir:=SelectDir+'';
- Edit1.Text:=SelectDir;
- end;
- end;
- procedure TForm1.BitBtn2Click(Sender: TObject);
- begin
- memo1.lines.Clear ;
- TotalFileNumbers:=0;
- RecurSearchFile(Edit1.Text,SearchFileType,memo1.lines, TotalFileNumbers);
- Label3.Caption:='查找结果显示:'+'一共在当前目录下找到'+IntToStr(TotalFileNumbers)+'个'+SearchFileType+'类型的文件';
- end;
- procedure TForm1.BitBtn3Click(Sender: TObject);
- begin
- Close;
- end;
- end.