如何得到一个文件加下的所有文件的文件名(50分)

  • 主题发起人 主题发起人 jindgu
  • 开始时间 开始时间
J

jindgu

Unregistered / Unconfirmed
GUEST, unregistred user!
比如有d:/a目录下有b/1.*,2.*,3.*;c/d/1.*;1.*,2.*等等,然后当给定路径d
:/a目录时,可以把这些文件目录的文件名都读出来并写入某个txt文件中如:
b/
1.*
2.*
3.*
c/
d/
1.*
1.*
2.*
 
提前。没人知道?分不够可以加
 
用FileListBox1控件
FileListBox1.Directory:='目录'
FileListBox1.Items.SaveToFile('文件名');
 
to yuzk2005:
这个控件哪有下?或者你发一个给我,jindgu@tom.com

另:用其他方法比如系统的API不能解决这问题吗?
我觉得就是某个函数,然后做个递归就可以解决了,就是不知道该用哪个函数
 
//功能:搜索文件和文件夹
//参数:strPath: 搜索路径;
//返回值: 无
//
procedure TFileSearch.SearchFileInfo(strPath:String);
var
fRec :TSearchRec;
tmpPathName,tmpstring,PathName:String ;
FindResult:shortint;
iLen:integer;
i:integer;
sInfo:TShFileInfo;
FInfo:TFileInfos;
begin
if not FbBeginSearch then exit;
PathName:=strPath;
iLen:=StrLen(PChar(PathName));
if(PathName[iLen]<>'/')then
begin
PathName:=PathName+'/';
end;
tmpPathName:=PathName+'*.*';
FindResult:= FindFirst(tmpPathName,faAnyFile,fRec) ;
try
//找第一个文件
while (FindResult=0 ) do
begin
if not FbBeginSearch then break;
if(fRec.Name='')then
begin //2003.3.11 发现查找出现fRec.Name=''的现象
FindResult:=FindNext(fRec);
Continue;
end;

if (fRec.Attr and faDirectory <>faDirectory)and(fRec.Name<>'.') and (fRec.Name <> '..') then
begin
//找到文件
end; //if (fRec.Attr and faDirectory) <>0 then
Sleep(1);
FindResult:=FindNext(fRec);
end ; //end while
if FbSearchSubdir then // //是否搜索子目录
begin
FindResult:=FindFirst(tmpPathName,faDirectory,fRec);
while FindResult=0 do
begin
if not FbBeginSearch then break;
if ((fRec.Attr and faDirectory)=faDirectory)
and (fRec.Name<>'.') and (fRec.Name<>'..') then
begin
tmpPathName:= PathName + fRec.Name+'/';
SearchFileInfo(tmpPathName); //递归调用本身;
end;
Sleep(1);
FindResult:=FindNext(fRec);
end; //end while
end; //if FbSearchSubdir then
finally
SysUtils.FindClose(fRec);
end;
end;
 
查找所有文件
procedure findall(disk,path: String; var fileresult: Tstrings);

var

fpath: String;

fs: TsearchRec;

begin

fpath:=disk+path+'/*.*';

if findfirst(fpath,faAnyFile,fs)=0 then

begin

if (fs.Name<>'.')and(fs.Name<>'..') then

if (fs.Attr and faDirectory)=faDirectory then

findall(disk,path+'/'+fs.Name,fileresult)

else

fileresult.add(disk+strpas(strupper(pchar(path)))+'/'+strpas(

strupper(pchar(fs.Name)))+'('+inttostr(fs.Size)+')');

while findnext(fs)=0 do

begin

if (fs.Name<>'.')and(fs.Name<>'..') then

if (fs.Attr and faDirectory)=faDirectory then

findall(disk,path+'/'+fs.Name,fileresult)

else

fileresult.add(disk+strpas(strupper(pchar(path)))+'/'+str

pas(strupper(pchar(fs.Name)))+'('+inttostr(fs.Size)+')');

end;

end;

findclose(fs);

end;
 
楼上两位的代码我也有,可是并不能实现我要的功能吧
 
FileListBox Delphi自带的
 
查找文件相关的函数:FindFirst、FindNext、FindClose
写文件,直接用WriteLn即可呀。
procedure SearchFile(myF: Textfile, dir: String);
begin
查找dir目录;
while 尚未查找结束
if 查找到的是文件,则写入myF
else if 查找到的是目录, 则调用SearchFile继续查找该目录。
查找下一个。
done。

end;
 
列出指定目录下的所有文件
procedure ListDir(Path:String; List:TListBox);
{
Path : 起始路径字符串
List : 存放文件名的 List box
}
var
SearchRec:TsearchRec;
Result:integer;
S:string; { 用以保存当前目录, GetDir(0,s) }
begin
try {Exception handler }
ChDir(Path);
except on EInOutError do
begin
MessageDlg('改变目录时发生错误',mtWarning,[mbOK],0);
Exit;
end;
end;
if length(path)<> 3 then path:=path+'/'; { 检查是否根目录,如果不是就在字符串尾部加上'/' }
FindFirst(path+'*.*',faAnyFile,SearchRec); { 并在尾部加上 '*.*' 以便搜索所有文件 }
Repeat
if SearchRec.Attr=faDirectory then { 如果是目录,就...}
begin
if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then { 忽略 '.' 和 '..' }
begin
GetDir(0,s); { 求默认驱动器的当前目录 }
if length(s)<>3 then s:=s+'/'; { 检查是否根目录 }
List.Items.Add(s+SearchRec.Name); { 加入列表 }
ListDir(s+SearchRec.Name,List); { ListDir 查找目录 }
end;
end
else { 如果不是目录 }
begin
GetDir(0,s); { 求默认驱动器的当前目录 }
if length(s)<>3 then List.items.add(s+'/'+SearchRec.Name) { 检查是否根目录 }
else List.items.add(s+SearchRec.Name); { 加入列表 }
end;
Result:=FindNext(SearchRec);
Application.ProcessMessages;
until result<>0; { 已经列出所有文件 }
GetDir(0,s);
if length(s)<>3 then ChDir('..'); { 如果不是根目录,就返回上一 Level }
end;
 
多人接受答案了。
 
后退
顶部