如何遍历一个文件夹下的所有文件

angle0 2002-10-08 04:18:30
如何遍历一个文件夹下的所有文件
...全文
350 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
dschebei 2002-10-16
  • 打赏
  • 举报
回复
看来用循环的办法太笨了,控件没item之类的属性吗?
ketao_78 2002-10-16
  • 打赏
  • 举报
回复
不错
SKJG 2002-10-08
  • 打赏
  • 举报
回复
使用FindFirsiFile,FindNextFile,FindClose函数
具体的参数用法参考MSDN

算法流程

1.找到该文件夹下的一个文件
2.如果该文件是文件夹,转1
3.处理文件
4.如果还有文件,转1
maozhuxiwansui 2002-10-08
  • 打赏
  • 举报
回复
Function FindPicture(dstDir:String):Boolean;
var
hFindFile:Cardinal;
tfile,Ext,MainName:String;
FindFileData:WIN32_FIND_DATA;
begin
ChDir(dstDir);
hFindFile:=FindFirstFile('*.*',FindFileData);
if hFindFile<>INVALID_HANDLE_VALUE then
begin
repeat
tfile:=FindFileData.cFileName;
if (tfile='.') or (tfile='..') then
Continue;
if (FindFileData.dwFileAttributes=FILE_ATTRIBUTE_DIRECTORY) Then
Begin
if dstDir[Length(dstDir)]<>'\' then
FindPicture(dstDir+'\'+tfile)
else
FindPicture(dstDir+tfile);
End
else
Begin
//Mainform.ResultMemo.Lines.Add(tfile);
//在这里加入你要处理的代码
End
until FindNextFile(hFindFile,FindFileData)=False;
Windows.FindClose(hFindFile);
end;
Result:=True;
End;

//因为用API写的,估计速度比较快!
ahuige 2002-10-08
  • 打赏
  • 举报
回复
procedure TForm1.Button1Click(Sender: TObject);
var f:tsearchrec;
s:string;
begin

if edit1.Text='' then exit;
if edit1.text[length(edit1.text)]<>'\' then
s:=edit1.Text+'\*.*'
else s:=edit1.Text+'*.*';
findfirst(s,faanyfile,f);

memo1.Lines.Add(f.name);

while findnext(f)=0 do
memo1.Lines.Add(f.name);




end;

longlongge 2002-10-08
  • 打赏
  • 举报
回复
FindFirst
FindNext
FindClose
bzm 2002-10-08
  • 打赏
  • 举报
回复
将以下存为一个PAS, 再引用它, 非常小巧的算法,

你要设置你要遍历的文件夹,和你要找的文件属性,

再把你找到文件要处理的动作写在
//****要处理的事件 ExecuteFile(MyStr+MyF.Name);
这里就行了,,

如找到一个 C:\windows\bzm.bmp,那么 MyStr = 'C:\windows\'
MyF.Name = 'bzm.bmp'

---------
unit SreachFile;

//+----------------------------------+
//| 共有一个过程。 |
//| |
//| 自动递归查找目录文件 |
//| |
//| MyStr : 目录名 |
//| MyAttr : 查找文件属性 |
//+----------------------------------+

interface
uses SysUtils;

procedure SearchNext(MyStr : String; MyAttr : Integer);
implementation

procedure SearchNext(MyStr : String; MyAttr : Integer);
var
MyF : TSearchRec;
begin
if FindFirst(MyStr+'*.*', MyAttr, MyF) = 0 then
begin
If ((MyF.Attr And faDirectory)=$00000010) and
(MyF.Name <> '..') And (MyF.Name <> '.') then
begin
SearchNext(MyStr+MyF.Name+'\', MyAttr);
end;

if (MyF.Name <> '..') And (MyF.Name <> '.') then
begin
//****要处理的事件 ExecuteFile(MyStr+MyF.Name);
end;

While FindNext(MyF)=0 do
begin
If ((MyF.Attr And faDirectory)=$00000010) and
(MyF.Name <> '..') And (MyF.Name <> '.') then
begin
SearchNext(MyStr+MyF.Name+'\', MyAttr);
end;

if ((MyF.Attr And faDirectory)<>$00000010) and
(MyF.Name <> '..') And (MyF.Name <> '.') then
begin
//****要处理的事件 ExecuteFile(MyStr+MyF.Name);
end;

end;
end;
FindClose(MyF);


end;
end.
quark 2002-10-08
  • 打赏
  • 举报
回复
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm_Main.Button5Click(Sender: TObject);
var TargetDateTime: TDateTime;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure SetDirFileTime(DirName:string);
var DirInfo: TSearchRec;
DosError: Integer;
begin
DosError := FindFirst(DirName+'\*.*', FaAnyfile, DirInfo);
while DosError=0 do
begin
if ((DirInfo.Attr and FaDirectory)=faDirectory) and (DirInfo.Name<>'.') and (DirInfo.Name<>'..')
then SetDirFileTime(DirName + '\' + DirInfo.Name);
{$IF DEFINED(WIN32) AND DECLARED(UsingVCL)}
if ((DirInfo.Attr and FaDirectory)<>FaDirectory) and ((DirInfo.Attr and FaVolumeID)<>FaVolumeID)
{$ELSE}
if ((DirInfo.Attr and FaDirectory)<>FaDirectory)
{$IFEND}
then if (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,4)=ReverseStr('.DDP'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,4)=ReverseStr('.BAK'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,4)=ReverseStr('.TMP'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,4)=ReverseStr('.LOG'))
//or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,4)=ReverseStr('.DCU'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,5)=ReverseStr('.~PAS'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,5)=ReverseStr('.~DFM'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,5)=ReverseStr('.EML'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,3)=ReverseStr('.MB'))
then DeleteFile(pChar(DirName + '\' + DirInfo.Name))
else begin
Memo.Lines.Add(DirName + '\' + DirInfo.Name);
try SetFileDateTime(DirName + '\' + DirInfo.Name,TargetDateTime) except end;
end;
DosError := FindNext(DirInfo);
end;
SysUtils.FindClose(DirInfo);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
TargetDateTime := Date;
Memo.Lines.Clear;
SetDirFileTime(TargetDir);
end;
lsinc 2002-10-08
  • 打赏
  • 举报
回复
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DirOutln, FileCtrl, OutLine, Grids, StdCtrls;

type
TForm1 = class(TForm)
DriveComboBox1: TDriveComboBox;
DirectoryListBox1: TDirectoryListBox;
Edit1: TEdit;
lbFiles: TListBox;
SearchForFiles: TButton;
Edit2: TEdit;
procedure SearchForFilesClick(Sender: TObject);
procedure lbFilesClick(Sender: TObject);
private
{ Private declarations }
FFileName:string;
Function GetDirectoryName(Dir:string):string;
procedure FindFiles(APath:string);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FindFiles(APath: string);
var
FsearchRec,
DsearchRec:TSearchRec;
FindResult:integer;

function IsDirNotation(ADirName:string):Boolean;
begin
Result:=(ADirName='.') or (ADirName='..');
end;
begin
APath:=GetDirectoryName(APath);
FindResult:=FindFirst(APath+FFileName,faAnyFile+faHidden+faSysFile+faReadOnly,FsearchRec);
try
while FindResult=0 do
begin
lbFiles.Items.Add(LowerCase(APath+FsearchRec.Name));
FindResult:=FindNext(FSearchRec);
end;

FindResult:=FindFirst(APath+'*.*',faDirectory,DsearchRec);

while FindResult=0 do
begin
if ((DsearchRec.Attr and faDirectory)=faDirectory) and Not IsDirNotation(DsearchRec.Name) then
FindFiles(APath+DsearchRec.Name);
FindResult:=FindNext(DSearchRec);
end;
finally
FindClose(FSearchRec);
end;
end;

function TForm1.GetDirectoryName(Dir: string): string;
begin
if Dir[Length(Dir)]<>'\' then
Result:=Dir+'\'
else
Result:=Dir;
end;

procedure TForm1.SearchForFilesClick(Sender: TObject);
begin
Screen.Cursor:=crHourGlass;
try
lbFiles.Items.Clear;
FFileName:=edit1.text;
FindFiles(DirectoryListBox1.Directory);
finally
Screen.Cursor:=crDefault;
end;
end;

procedure TForm1.lbFilesClick(Sender: TObject);
var
s:string;
begin
edit2.text:=lbFiles.Items[lbFiles.ItemIndex];
s:=ExtractFileName(Edit2.Text);
Delete(s,pos(copy(edit1.text,2,4),s),4);
edit2.text:=s;
edit2.SetFocus;
end;

end.


如果你有不清楚的
Email:lsinc@sina.com.cn
L.S

5,388

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧