如何遍历指定目录下的文件(急)(100分)

  • 主题发起人 主题发起人 panjf
  • 开始时间 开始时间
P

panjf

Unregistered / Unconfirmed
GUEST, unregistred user!
如何得到指定目录下的所有文件的文件名,因为要一一判断、操作
 
用FindFirst和FindNext。具体看看帮助吧。
 
记不太清了,好像是用win API FindFirst FindNext

我记得www.torry.ru下一个关于plug-in的例子里,
在扫描一个目录下所有plug-in时用到了。
 
好惨,又慢了一步。
 
如果考虑子目录,须结合上面两个函数用递归或用堆栈来解决。
 
用win API FindFirst FindNext,子目录用递归,不过要小心..and . 目录,不栏的话递归会死记
 
最简单的办法,用FILELISTBOX一行代码都不用写,把它隐藏起来,设置好路径
读它就行了(哈哈,有点不太专业)
 
Delphi本身就有FindFirst、FindNext,何必要用API。

procedure TForm1.FindAll(const Path: String);
var
sr:TSearchRec;
fr:Integer;
begin
fr:=FindFirst(Path,faAnyFile,sr);
while fr=0 do
begin
if (sr.Attr=faDirectory)and(sr.Name<>'.')and(sr.Name<>'..') then
FindAll(sr.Name) //递归查找下一个目录
else
begin
//处理文件
end;
FindNext(sr);
end;
FindClose(sr);
end;
 
需要用到递归, 网上应该有很多这样的源程序.

不过, wuling 的办法也不失为一个好办法(在某种情况下).
 
//agree 教父
 
; 哈,我上次做了一個程序,就是把指定目錄下的文件和文件夾統一顯示列表出來且顯示文件
或文件夾的大小,屬性,最後修改日期,完整路徑,且可遞歸下面多級子目錄,需要的說,panjf,
你要的話,可要給我滿分啦...
 
》》JELLYMAN
能给我发一分吗???
 
试试这个,(网上摘录):
Procedure FindRecursive( Const path: String; Const mask: String;
LogFunction: TLogFunct );
Var
fullpath: String;
Function Recurse( Var path: String; Const mask: String ): Boolean;
Var
SRec: TSearchRec;
retval: Integer;
oldlen: Integer;
Begin
Recurse := True;

oldlen := Length( path );
(* phase 1, look for normal files *)
retval := FindFirst( path+mask, faAnyFile, SRec );
While retval = 0 Do Begin
If (SRec.Attr and (faDirectory or faVolumeID)) = 0 Then
(* we found a file, not a directory or volume label,
log it. Bail out if the log function returns false. *)
If not LogFunction( path, SRec ) Then Begin
Result := False;
Break;
End;

retval := FindNext( SRec );
End;
FindClose( SRec );
If not Result Then Exit;

(* Phase II, look for subdirectories and recurse thru them *)
retval := FindFirst( path+'*.*', faDirectory, SRec );
While retval = 0 Do Begin
If (SRec.Attr and faDirectory) <> 0 Then (* we have a directory *)
If (SRec.Name <> '.') and (SRec.Name <> '..') Then Begin
path := path + SRec.Name + '/';
If not Recurse( path, mask ) Then Begin

Result := False;
Break;
End;
Delete( path, oldlen+1, 255 );
End;
retval := FindNext( SRec );
End;
FindClose( SRec );
End;
Begin
If path = '' Then
GetDir(0, fullpath)
Else
fullpath := path;
If fullpath[Length(fullpath)] <> '/' Then
fullpath := fullpath + '/';
If mask = '' Then
Recurse( fullpath, '*.*' )
Else
Recurse( fullpath, mask );

End;
 
搜索一下,以前有很多这样的问题。
我也是通过搜索得到解决方法的
下面是我写的一个程序中copy的一段,
参考一下,可以解决问题。
var
searchrec:Tsearchrec;
directoryname:string;
arryfilename:array[0..1000] of string;
i,j:integer;
begin
i:=1;j:=1;

//選擇文件夾
if selectdirectory('請選擇圖片所在的文件夾:','D:/',directoryname)
then begin
directoryname:=directoryname+'/'
end
else begin
showmessage('你必須選擇一個文件夾');
exit;
end;

//遍歷文件
if findfirst(directoryname+'*.*',faArchive,searchrec)=0 then
begin
arryfilename[0]:=searchrec.name;
// memo1.Lines.Add(arryfilename[0]);
while (findnext(searchrec)=0) and (i<1000) do
begin
arryfilename:=searchrec.Name;
memo1.Lines.add(arryfilename);
i:=i+1;
end;
i:=i-1;
end;
end;
 
能给我发一份吗?JELLYMAN
先谢谢了。
Email:fortuneme@163.net
 
JELLYMAN,发到我的信箱好吗?如果你能告诉我怎样删除string类型的后几个字符,我就把
分都给你 -P
 
;還有誰要?,請直接發e-mail to me :jellyman@china.com
 
删除Str的后i个字符。
function DelLastStr(const str:String;const i:Integer):String;
begin
Result:=Copy(Str,1,Length(Str)-i);
end;

就这么简单。
 
我是这样写的。


unit MainFrm;

interface

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

type
TMainForm = class(TForm)
dcbDrives: TDriveComboBox;

edtFileMask: TEdit;
lblFileMask: TLabel;
btnSearchForFiles: TButton;
lbFiles: TListBox;
dolDirectories: TDirectoryOutline;
RichEdit1: TRichEdit;
Button1: TButton;

procedure btnSearchForFilesClick(Sender: TObject);
procedure dcbDrivesChange(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
FFileName: String;
function GetDirectoryName(Dir: String): String;
procedure FindFiles(APath: String);
end;

var
MainForm: TMainForm;

implementation

{$R *.DFM}

function TMainForm.GetDirectoryName(Dir: String): String;
{ This function formats the directory name so that it is a valid
directory containing the back-slash (/) as the last character. }
begin
if Dir[Length(Dir)]<> '/' then
Result := Dir+'/'
else
Result := Dir;
end;

procedure TMainForm.FindFiles(APath: String);
{ This is a procedure which is called recursively so that it finds the
file with a specified mask through the current directory and its
sub-directories. }
var
FSearchRec,
DSearchRec: TSearchRec;
FindResult: integer;
FindResult2: integer;
function IsDirNotation(ADirName: String): Boolean;
begin
Result := (ADirName = '.') or (ADirName = '..');
end;

begin
APath := GetDirectoryName(APath); // Obtain a valid directory name
{ Find the first occurence of the specified file name }
FindResult := FindFirst(APath+FFileName,faAnyFile+faHidden+
faSysFile+faReadOnly,FSearchRec);
//new add
// FindResult2 := FindFist(Apath );

lbFiles.Items.Add(LowerCase(APath));
try
{ 继续查找文件,查到加到 ListBox }
while FindResult = 0 do
begin
lbFiles.Items.Add(LowerCase(APath+FSearchRec.Name));
FindResult := FindNext(FSearchRec);
end;

{ Now search the sub-directories of this current directory. Do this
by using FindFirst to loop through each subdirectory, then call
FindFiles (this function) again. This recursive process will
continue until all sub-directories have been searched. }
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); // Recursion here
FindResult := FindNext(DSearchRec);
end;
finally
FindClose(FSearchRec);
end;
end;

procedure TMainForm.btnSearchForFilesClick(Sender: TObject);
{ This method starts the searching process. It first changes the cursor
to an hourglass since the process may take awhile. It then clears the
listbox and calls the FindFiles() function which will be called
recursively to search through sub-directories }
begin
Screen.Cursor := crHourGlass;
try
lbFiles.Items.Clear;
FFileName := edtFileMask.Text;
FindFiles(dolDirectories.Directory);
finally
Screen.Cursor := crDefault;
end;
end;

procedure TMainForm.dcbDrivesChange(Sender: TObject);
begin
dolDirectories.Drive := dcbDrives.Drive;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
try
lbFiles.Items.Clear;
// richedit1.Clear;
FFileName := '*.*';
FindFiles('d:/kaoshi/b/');
finally
Screen.Cursor := crDefault;
end;
end;

end.
 
接受答案了.
 
后退
顶部