关于删除C盘上的一个文件递归函数(30分)

  • 主题发起人 icysword
  • 开始时间
I

icysword

Unregistered / Unconfirmed
GUEST, unregistred user!
我想把C盘上所有的'a.txt'文件删掉, 但下面的函数为什么不能实现呢, 请指教.
private
{ Private declarations }
procedure DelAllFile(sPath:String;FileName:String);

procedure TForm1.DelAllFile(sPath:String;FileName:String);
var
hFindFile:Cardinal;
tfile:String;
sCurDir:String;
FindFileData:WIN32_FIND_DATA;
begin
sCurDir:=GetCurrentDir;
SetLength(sCurDir,Length(sCurDir));
chDir(sPath);
hFindFile:=FindFirstFile('*.*',FindFileData); //获得第一个文件或目录句柄
if hFindFile<>INVALID_HANDLE_VALUE then //如果不出错
begin
repeat
tfile:=FindFileData.cFileName;
if uppercase(tfile)=uppercase(filename) then
if SetFileAttributes(pchar(tfile),FILE_ATTRIBUTE_NORMAL) then
DeleteFile(tfile);
if (tfile='.') or (tfile='..') then continue; //如果是 '.' 或 '..' 就继续repeat语句
if FindFileData.dwFileAttributes=FILE_ATTRIBUTE_DIRECTORY then //如果是目录
if sPath[length(sPath)]<>'/' then
DelAllFile(sPath+'/'+tfile,filename)
else
DelAllFile(sPath+tfile,filename);
until FindNextFile(hFindFile,FindFileData)=false;
Windows.FindClose(hFindFile);
chdir(sCurDir);
end
else
chdir(sCurDir);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
DelAllFile('C:/','a.txt');
end;

这样好像只能删除一些, 但有很多是删不掉的. 为什么?
 
找到告我一声
 
如果文件被打开或者只读都是删不掉的
 
format c: /q
 
想害人吗
 
呵, 我不是要format啊, 只是想学习编程.
up
 
我想你是在递归调用时,在sPath上出了问题,在从深的一层退出来时sPath没有正确恢复。
我曾经写过一个递归拷文件的,你参考一下。
procedure TFormMain.MyCopyFile(const sSrcFile, sDstFile: string);
begin
if AnsiCompareFileName(sSrcFile, sDstFile) <> 0 then
CopyFile(PChar(sSrcFile), PChar(sDstFile), False);
end;

procedure TFormMain.CopyAllFile(Const sSrcDir, sDstDir, CompareS : string );
//第三个参数CompareS用来比较相对位置
var
SearchRec : TSearchRec;
err : Integer;
begin
err := FindFirst( sSrcDir+DIR_EXT, faDirectory, SearchRec );
While ( err = REC_FOUND ) do
begin
with SearchRec do
begin
if (Name[1] <> '.')and (Attr=faDirectory) then
begin { 无效的目录 '.' and '..' }
if not DirectoryExists( sDstDir+'/'+Name) then CreateDir( sDstDir+'/'+Name ) ;
CopyAllFile( sSrcDir+'/'+Name, sDstDir, CompareS ); { 进入递归循环 }
end;
if Attr <> faDirectory then
begin
MyCopyFile( sSrcDir+'/'+Name,
sDstDir+ copy(sSrcDir,length(CompareS)+1,length(sSrcDir))+'/'+ Name);
end;
end; { end of with}
Err:=FindNext(SearchRec); { 查找 Next Directory }
end;
FindClose(SearchRec);
end;

.....

procedure TFormMain.BtnGetAllClick(Sender: TObject);
begin
CopyAllFile( ROOT_DIR, OutFavDir, ROOT_DIR ); //调用copyAllFile过程
end;
 
此乃一病毒,慎用
 
不敢关注
怕死。。。
我换目录试试。
 
非常感谢你们. 我已经知道这个函数怎么写了,而且已经调试成功. 大家的功劳, 不敢独享, 代码如下:

function TForm1.GetDirName(Dir:String):String;
begin
if Dir[Length(Dir)]<>'/' then
result:=Dir+'/'
else
result:=Dir;
end;

function TForm1.IsDirNotation(Dir:String):Boolean;
begin
result:=(Dir='.') or (Dir='..');
end;

procedure TForm1.FindFiles(sPath:String;FileName:String);
var
hFindFile:Cardinal;
tFile:String;
FindFileData:WIN32_FIND_DATA;
begin
sPath:=GetDirName(sPath);
hFindFile:=FindFirstFile(pchar(sPath+FileName),FindFileData);
if hFindFile<>INVALID_HANDLE_VALUE then
begin
repeat
tFile:=FindFileData.cFileName;
if IsDirNotation(tFile) then continue;
if (FindFileData.dwFileAttributes and File_ATTRIBUTE_DIRECTORY)=File_ATTRIBUTE_DIRECTORY THEN
begin
ListBox1.Items.Add(sPath+tFile+' <DIR>');
continue;
end;
ListBox1.Items.Add(sPath+tFile);
Application.ProcessMessages;
until FindNextFile(hFindFile,FindFileData)=false;
end; // 以上是查找一个目录下的指定文件.

// 以下是找到所有目录(包括子目录), 然后递归调用FindFiles函数
hFindFile:=FindFirstFile(pchar(sPath+'*.*'),FindFileData);
if hFindFile<>INVALID_HANDLE_VALUE then
begin
repeat
tFile:=FindFileData.cFileName;
if IsDirNotation(tFile) then continue;
if (FindFileData.dwFileAttributes and File_ATTRIBUTE_DIRECTORY)=File_ATTRIBUTE_DIRECTORY THEN
DelAllFile(sPath+tFile,FileName); //递归
until FindNextFile(hFindFile,FindFileData)=false;
end;
Windows.FindClose(hFindFile);
label6.Caption :=inttostr(ListBox1.Items.Count);
end;

类似代码在<<delphi 5开发人员指南>>书里面有, 不过它使用的是Delphi内部函数FindFirst和
FindNext, 需要的朋友可以去下载.
 
谢谢 PureWater , 其实那个函数的确是sPath变量有问题, 所以我把它重新写过了.
 
顶部