【delphi开源代码栏目提醒】:网学会员在delphi开源代码频道为大家收集整理了Main_Form_u.pas提供大家参考,希望对大家有所帮助!
unit Main_Form_u;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Menus;
type
TMain_Form = class(TForm)
GroupBox1: TGroupBox;
Edit1: TEdit;
GroupBox2: TGroupBox;
Memo1: TMemo;
BitBtn1: TBitBtn;
PopupMenu1: TPopupMenu;
S1: TMenuItem;
SaveDialog1: TSaveDialog;
procedure BitBtn1Click(Sender: TObject);
procedure S1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Main_Form: TMain_Form;
Function FindFile(const FileSpec: TFileName;attributes: integer): TStringList;
Function FileType(const FileName: TFileName): String; Export;
implementation
{$R *.dfm}
//----模糊查找------------------------------------------------------------------
Function FindFile(const FileSpec: TFileName;attributes: integer): TStringList; Export;
var
Spec: String; //文件名
list: TStringList;
//------------------
查询下级目录的子过程
procedure RFindFile(const Folder: TFileName);
var
SearchRec: TSearchRec;
begin
if FindFirst(Folder + Spec, Attributes, SearchRec)=0 then
begin
try
repeat
if (SearchRec.Attr and faDirectory = 0) or (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
list.Add(Folder + SearchRec.Name);
until FindNext(SearchRec) <> 0;
except
FindClose(SearchRec);
raise;
end;
FindClose(SearchRec);
end;
if FindFirst(Folder + '*', Attributes Or faDirectory, SearchRec) = 0 then
begin
try
repeat
if ((SearchRec.Attr and faDirectory) <> 0) and
(SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
RFindFile(Folder + SearchRec.Name + '\');
until FindNext(SearchRec) <> 0;
except
FindClose(SearchRec);
raise;
end;
FindClose(SearchRec);
end;
end;
//------------------
begin
List := TStringList.Create;//创建字符传
列表 try
spec := ExtractFileName(filespec);//返回指定文件名
RFindFile(ExtractFilePath(filespec));//返回指定路径
Result := list;//函数返回值是List;
Except
List.Free;
raise;
end;
end;
//---文件类型函数---------------------------------------------------------------
Function FileType(const FileName: TFileName): String;
var I: integer;
begin
For I:=Length(FileName) downto 0 do
begin
if Copy(FileName,I,1)='.' then
begin
Result:=Copy(FileName,I,Length(FileName)-I);
end;
end;
end;
procedure TMain_Form.BitBtn1Click(Sender: TObject);
begin
Memo1.Lines:=FindFile(Edit1.Text,0);
Memo1.Lines.Add('------共计:['+IntToStr(Memo1.Lines.Count)+']个文件');
end;
procedure TMain_Form.S1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
Memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;
end.