全自动化的哦,找所有盘符,我没加盘符的错误处理,你自己加一下吧
unit FIndFileFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;
type
TFindFileForm = class(TForm)
ButtonFind: TButton;
GroupBox1: TGroupBox;
ListBoxFileFind: TListBox;
GroupBox2: TGroupBox;
EditFileName: TEdit;
ListBoxFileName: TListBox;
ButtonAddFileName: TButton;
ButtonDelFileName: TButton;
ButtonClearFileName: TButton;
ButtonExit: TButton;
StatusBar: TStatusBar;
ButtonCancelFind: TButton;
procedure ButtonFindClick(Sender: TObject);
procedure ButtonAddFileNameClick(Sender: TObject);
procedure ButtonDelFileNameClick(Sender: TObject);
procedure ButtonClearFileNameClick(Sender: TObject);
procedure ButtonCancelFindClick(Sender: TObject);
procedure ButtonExitClick(Sender: TObject);
private
{ Private declarations }
procedure FindFile(Directory: string; FileNameLst: TStrings);
procedure GetDriverInfo;
public
{ Public declarations }
end;
var
FindFileForm: TFindFileForm;
DriverLst: TStrings;
CancelFind: Boolean;
implementation
{$R *.DFM}
procedure tfindfileform.GetDriverInfo;
var
DriveLetter: char;
begin
for DriveLetter := 'A' to 'Z' do
if (GetDriveType(PChar(DriveLetter + ':/')) = DRIVE_REMOVABLE) or (GetDriveType(PChar(DriveLetter + ':/')) = DRIVE_FIXED) or (GetDriveType(PChar(DriveLetter + ':/')) = DRIVE_REMOTE) then
DriverLst.Add(DriveLetter + ':/');
end;
procedure tfindfileform.FindFile(Directory: string; FileNameLst: TStrings);
var
Search, Src: TSearchRec;
RootDirectory: string;
FCount: Integer;
begin
Application.ProcessMessages;
if CancelFind then Exit;
//查找文件
RootDirectory := Directory;
if RootDirectory[Length(RootDirectory)] <> '/' then RootDirectory := RootDirectory + '/';
//先查找文件
for Fcount := 0 to filenamelst.Count - 1 do
if FindFirst(RootDirectory + FileNameLst[FCount], faArchive, Src) = 0 then
ListBoxFileFind.Items.Add(RootDirectory + FileNameLst[FCount]);
//再查目录
if FindFirst(RootDirectory + '*.*', faDirectory, Search) = 0 then
repeat
if (Search.Name <> '.') and (Search.Name <> '..') then
if (Search.Attr and fadirectory) = fadirectory then
begin
StatusBar.Panels[1].Text := '正在查找...' + RootDirectory + Search.Name;
FindFile(RootDirectory + Search.Name, FileNameLst);
end;
until FindNext(Search) <> 0;
FindClose(Search);
end;
procedure TFindFileForm.ButtonFindClick(Sender: TObject);
var
i: Integer;
begin
ButtonCancelFind.Enabled := True;
CancelFind := False;
if ListBoxFileName.Items.Count <> 0 then
begin
DriverLst := TStringList.Create;
try
//查找文件,并添加到ListboxFindFile
GetDriverinfo;
for i := 0 to DriverLst.Count - 1 do
FindFile(DriverLst, ListBoxFileName.Items);
finally
DriverLst.Free;
end;
end;
ButtonCancelFind.Enabled := False;
end;
procedure TFindFileForm.ButtonAddFileNameClick(Sender: TObject);
begin
if EditFileName.Text <> '' then
ListBoxFileName.Items.Add(EditFileName.Text);
end;
procedure TFindFileForm.ButtonDelFileNameClick(Sender: TObject);
begin
if ListBoxFileName.ItemIndex <> -1 then
ListBoxFileName.Items.Delete(ListBoxFileName.ItemIndex);
end;
procedure TFindFileForm.ButtonClearFileNameClick(Sender: TObject);
begin
ListBoxFileName.Items.Clear;
end;
procedure TFindFileForm.ButtonCancelFindClick(Sender: TObject);
begin
CancelFind := True;
end;
procedure TFindFileForm.ButtonExitClick(Sender: TObject);
begin
Close;
end;
end.