找回密码
 加入我们

QQ登录

只需一步,快速开始

搜索
查看: 4235|回复: 0

[开源] Delphi查找指定文件的例程

[复制链接]

1214

主题

352

回帖

11

精华

管理员

菜鸟

积分
93755

贡献奖关注奖人气王精英奖乐于助人勋章

发表于 2009-9-27 19:35:35 | 显示全部楼层 |阅读模式
<p><font face="Verdana">unit Unit1;<br/>interface<br/>uses<br/>&nbsp; Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,<br/>&nbsp; StdCtrls, FileCtrl;<br/>type<br/>&nbsp; TForm1 = class(TForm)<br/>&nbsp;&nbsp;&nbsp; Button1: TButton;<br/>&nbsp;&nbsp;&nbsp; ListBox1: TListBox;<br/>&nbsp;&nbsp;&nbsp; procedure Button1Click(Sender: TObject);<br/>&nbsp; private<br/>&nbsp;&nbsp;&nbsp; { Private declarations }<br/>&nbsp; public<br/>&nbsp;&nbsp;&nbsp; { Public declarations }<br/>&nbsp; end;<br/>var<br/>&nbsp; Form1: TForm1;<br/>implementation<br/>{$R *.DFM}<br/>{---------------------------------------<br/>&nbsp;文件查找函数 SearchFile<br/>&nbsp;参数说明:<br/>&nbsp;&nbsp;&nbsp;&nbsp; sFileName: 要查找的文件名称<br/>&nbsp;&nbsp;&nbsp;&nbsp; sRootDir:&nbsp; 指定在哪个目录中查找<br/>&nbsp;&nbsp;&nbsp;&nbsp; bFileOnly: 是否只查找文件<br/>&nbsp;&nbsp;&nbsp;&nbsp; bRecurse:&nbsp; 是否查找子目录<br/>&nbsp;返回值:<br/>&nbsp;&nbsp;&nbsp;&nbsp; FileList:&nbsp; 查找结果列表<br/>----------------------------------------}<br/>//正式函数开始<br/>function SearchFile(sFileName, sRootDir: string;<br/>&nbsp; bFileOnly, bRecurse: boolean): TStringList;<br/>&nbsp;&nbsp;&nbsp; //内嵌文件查找递归过程<br/>&nbsp; procedure DoSearchFile(sFileName, sRootDir: string;<br/>&nbsp;&nbsp;&nbsp; bFileOnly, bRecurse: boolean;<br/>&nbsp;&nbsp;&nbsp; var FileList: TStringList);<br/>&nbsp; var<br/>&nbsp;&nbsp;&nbsp; Found: integer;<br/>&nbsp;&nbsp;&nbsp; SearchRec: TSearchRec;<br/>&nbsp; begin<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; //开始查找<br/>&nbsp;&nbsp;&nbsp; Found := FindFirst(sRootDir + '\*.*', faAnyFile, SearchRec);<br/>&nbsp;&nbsp;&nbsp; while Found = 0 do<br/>&nbsp;&nbsp;&nbsp; begin<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; //遇到子目录时确定是否查找子目录和是否将符合条件的子目录加入查找结果<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; if (SearchRec.Attr = faDirectory) and (SearchRec.Name &lt;&gt; '.') and<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (SearchRec.Name &lt;&gt; '..') then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; begin<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; if (AnsiCompareText(sFileName, SearchRec.Name) = 0) and not bFileOnly then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; FileList.Add(sRootDir + '\' + SearchRec.Name);<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; if bRecurse then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; DoSearchFile(sFileName, sRootDir + '\' + SearchRec.Name, bFileOnly, bRecurse, FileList);<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; end<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; //找到符合条件的文件时加入查找结果<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; else if AnsiCompareText(sFileName, SearchRec.Name) = 0 then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; FileList.Add(sRootDir + '\' + SearchRec.Name);<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Found := FindNext(SearchRec);<br/>&nbsp;&nbsp;&nbsp; end;<br/>&nbsp;&nbsp;&nbsp; FindClose(SearchRec);<br/>&nbsp; end;<br/>var<br/>&nbsp; FileList: TStringList;<br/>begin<br/>&nbsp; FileList := TStringList.Create;<br/>&nbsp; FileList.Clear;<br/>&nbsp; DoSearchFile(sFileName, sRootDir, bFileOnly, bRecurse, FileList);<br/>&nbsp; Result := FileList;<br/>end;</font></p>
<p><font face="Verdana">// 调用:<br/>procedure TForm1.Button1Click(Sender: TObject);<br/>{按Button时进行查找,结果显示到ListBox中}<br/>begin<br/>&nbsp; ListBox1.Items.Assign(SearchFile('Project1.dpr', 'd:', True, True));<br/>end;<br/>end.</font></p>
【VB】QQ群:1422505加的请打上VB好友
【易语言】QQ群:9531809  或 177048
【FOXPRO】QQ群:6580324  或 33659603
【C/C++/VC】QQ群:3777552
【NiceBasic】QQ群:3703755
您需要登录后才可以回帖 登录 | 加入我们

本版积分规则

快速回复 返回顶部 返回列表