procedure TForm1.Button1Click(Sender: TObject); var SearchRec: TSearchRec; i: Integer; begin ListBox1.Clear; i := FindFirst('D:\*.*', faAnyFile, SearchRec); while i = 0 do begin ListBox1.Items.Add(SearchRec.Name); i := FindNext(SearchRec); end; FindClose(SearchRec); end;
在Delphi中实现对目录拷贝、删除和搬移的操作 ( 阅读次数:4) 笔者在工作中遇到了需要对目录进行拷贝、删除和搬移的需求,Delphi本身提供了一些目录操作函数,但只是针对空目录而言,对目录下带有子目录的情况,更是无能为力。利用Win32 API函数和结构,以及递归的程序设计思想,笔者实现了对任意目录进行拷贝、删除和搬移的功能(分别相当于DOS中的XCopy、DelTree和Move命令)。以下分别给出了实现代码: 1、拷贝目录 为了能拷贝目录下带有子目录的情况,先定义一个辅助的拷贝函数,它是递归执行的,直到把目录下的所有文件和子目录都拷贝完。 1.1拷贝目录的递归辅助函数:DoCopyDir function DoCopyDir(sDirName:String; sToDirName:String):Boolean; var hFindFile:Cardinal; t,tfile:String; sCurDir:String[255]; FindFileData:WIN32_FIND_DATA; begin //先保存当前目录 sCurDir:=GetCurrentDir; ChDir(sDirName); hFindFile:=FindFirstFile('*.*',FindFileData); if hFindFile< >INVALID_HANDLE_VALUE then begin if not DirectoryExists(sToDirName) then ForceDirectories(sToDirName); repeat tfile:=FindFileData.cFileName; if (tfile='.') or (tfile='..') then Continue; if FindFileData.dwFileAttributes= FILE_ATTRIBUTE_DIRECTORY then begin t:=sToDirName+'\'+tfile; if not DirectoryExists(t) then ForceDirectories(t); if sDirName[Length(sDirName)]< >'\' then DoCopyDir(sDirName+'\'+tfile,t) else DoCopyDir(sDirName+tfile,sToDirName+tfile); end else begin t:=sToDirName+'\'+tFile; CopyFile(PChar(tfile),PChar(t),True); end; until FindNextFile(hFindFile,FindFileData)=false; FindClose(hFindFile); end else begin ChDir(sCurDir); result:=false; exit; end; //回到原来的目录下 ChDir(sCurDir); result:=true; end; ---- 1.2拷贝目录的函数:CopyDir function CopyDir(sDirName:String; sToDirName:string):Boolean; begin if Length(sDirName)< =0 then exit; //拷贝... Result:=DoCopyDir(sDirName,sToDirName); end; 2、删除目录 删除目录与拷贝目录很类似,但为了能删除位于根目录下的一个空目录,需要在辅助函数中设置一个标志变量,即:如果删除的是空目录,则置bEmptyDir为True,这一句已经用深色框表示了。 2.1删除目录的递归辅助函数:DoRemoveDir function DoRemoveDir(sDirName:String):Boolean; var hFindFile:Cardinal; tfile:String; sCurDir:String; bEmptyDir:Boolean; FindFileData:WIN32_FIND_DATA; begin //如果删除的是空目录,则置bEmptyDir为True //初始时,bEmptyDir为True bEmptyDir:=True; //先保存当前目录 sCurDir:=GetCurrentDir; SetLength(sCurDir,Length(sCurDir)); ChDir(sDirName); hFindFile:=FindFirstFile('*.*',FindFileData); if hFindFile< >INVALID_HANDLE_VALUE then begin repeat tfile:=FindFileData.cFileName; if (tfile='.') or (tfile='..') then begin bEmptyDir:=bEmptyDir and True; Continue; end; //不是空目录,置bEmptyDir为False bEmptyDir:=False; if FindFileData.dwFileAttributes= FILE_ATTRIBUTE_DIRECTORY then begin if sDirName[Length(sDirName)]< >'\' then DoRemoveDir(sDirName+'\'+tfile) else DoRemoveDir(sDirName+tfile); if not RemoveDirectory(PChar(tfile)) then result:=false else result:=true; end else begin if not DeleteFile(PChar(tfile)) then result:=false else result:=true; end; until FindNextFile(hFindFile,FindFileData)=false; FindClose(hFindFile); end else begin ChDir(sCurDir); result:=false; exit; end; //如果是空目录,则删除该空目录 if bEmptyDir then begin //返回上一级目录 ChDir('..'); //删除空目录 RemoveDirectory(PChar(sDirName)); end; //回到原来的目录下 ChDir(sCurDir); result:=true; end; 2.2删除目录的函数:DeleteDir function DeleteDir(sDirName:String):Boolean; begin if Length(sDirName)< =0 then exit; //删除... Result:=DoRemoveDir(sDirName) and RemoveDir(sDirName); end; 3、移动目录 有了拷贝目录和删除目录的函数,移动目录就变得很简单,只需顺序调用前两个函数即可: function MoveDir(sDirName:String; sToDirName:string):Boolean; begin if CopyDir(sDirName,sToDirName) then if RemoveDir(sDirName) then result:=True else result:=false; end;
找出所有的文件与目录:procedure TFTPMain.LocalUpdateListing; var F: TWin32FindData; Enum: Hwnd; R: Bool; FileName: string; FileSize: Int64; Magic:integer; item1:TListItem; begin Pointer(Enum) := nil; with Lview1 do try Clear; Update; Enum := FindFirstFile(PChar(FLocalPath + '*.*'), F); R := Pointer(Enum) <> nil; Magic:=0; while R do begin FileName := F.cFileName; if filename <>'.' then begin item1:=Lview1.Items.Add(); item1.SubItems.Add(''); item1.SubItems.Add(''); item1.SubItems.Add(''); LvAdd(Filename,0,0,item1); FileSize := (F.nFileSizeHigh shl 32) or (F.nFileSizeLow); if F.dwFileAttributes and faDirectory = faDirectory then begin item1.ImageIndex:=1; item1.SubItems.Strings[0]:='目录';//文件夹 item1.SubItems.Strings[1]:= '0'; end else begin item1.ImageIndex:=0; item1.SubItems.Strings[0]:='';//文件夹 item1.SubItems.Strings[1]:= FileSizeToString(FileSize); item1.SubItems.Strings[2]:= GetFileTypeDescription(FRemotePath + FileName, True); end; end; R := FindNextFile(Enum, F); end; finally windows.FindClose(Enum); RemoteSort:=False; end; end;function TFTPMain.GetFileTypeDescription(const Name: string; UseAttr: Boolean): string; var Info: TSHFileInfo; Flags: Cardinal; begin FillChar(Info, SizeOf(Info), 0); Flags := SHGFI_TYPENAME; if UseAttr then Flags := Flags or SHGFI_USEFILEATTRIBUTES; SHGetFileInfo(PChar(Name), 0, Info, SizeOf(Info), Flags); Result := Info.szTypeName; end;function TFTPMain.FileSizeToString(const Size: Int64): string; var S: Integer; begin if Size < 1024 then Result := IntToStr(Size) + ' Bytes'; S := Size div 1024; if S = 0 then S := 1; if S < 1024 then Result := IntToStr(S) + ' KB' else begin S := S div 1024; if S = 0 then S := 1; Result := IntToStr(S) + ' MB'; end;
var
SearchRec: TSearchRec;
i: Integer;
begin
ListBox1.Clear;
i := FindFirst('D:\*.*', faAnyFile, SearchRec);
while i = 0 do
begin
ListBox1.Items.Add(SearchRec.Name);
i := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;
到www.51delphi.com或http://skdweb.sdust.edu.cn/cree/amsite/看看
i是findfirst的返回值,你在delphi里看一下 FindFirst
的帮助就知道了。
( 阅读次数:4)
笔者在工作中遇到了需要对目录进行拷贝、删除和搬移的需求,Delphi本身提供了一些目录操作函数,但只是针对空目录而言,对目录下带有子目录的情况,更是无能为力。利用Win32 API函数和结构,以及递归的程序设计思想,笔者实现了对任意目录进行拷贝、删除和搬移的功能(分别相当于DOS中的XCopy、DelTree和Move命令)。以下分别给出了实现代码:
1、拷贝目录
为了能拷贝目录下带有子目录的情况,先定义一个辅助的拷贝函数,它是递归执行的,直到把目录下的所有文件和子目录都拷贝完。
1.1拷贝目录的递归辅助函数:DoCopyDir
function DoCopyDir(sDirName:String;
sToDirName:String):Boolean;
var
hFindFile:Cardinal;
t,tfile:String;
sCurDir:String[255];
FindFileData:WIN32_FIND_DATA;
begin
//先保存当前目录
sCurDir:=GetCurrentDir;
ChDir(sDirName);
hFindFile:=FindFirstFile('*.*',FindFileData);
if hFindFile< >INVALID_HANDLE_VALUE then
begin
if not DirectoryExists(sToDirName) then
ForceDirectories(sToDirName);
repeat
tfile:=FindFileData.cFileName;
if (tfile='.') or (tfile='..') then
Continue;
if FindFileData.dwFileAttributes=
FILE_ATTRIBUTE_DIRECTORY then
begin
t:=sToDirName+'\'+tfile;
if not DirectoryExists(t) then
ForceDirectories(t);
if sDirName[Length(sDirName)]< >'\' then
DoCopyDir(sDirName+'\'+tfile,t)
else
DoCopyDir(sDirName+tfile,sToDirName+tfile);
end
else
begin
t:=sToDirName+'\'+tFile;
CopyFile(PChar(tfile),PChar(t),True);
end;
until FindNextFile(hFindFile,FindFileData)=false;
FindClose(hFindFile);
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
//回到原来的目录下
ChDir(sCurDir);
result:=true;
end;
---- 1.2拷贝目录的函数:CopyDir
function CopyDir(sDirName:String;
sToDirName:string):Boolean;
begin
if Length(sDirName)< =0 then
exit;
//拷贝...
Result:=DoCopyDir(sDirName,sToDirName);
end;
2、删除目录
删除目录与拷贝目录很类似,但为了能删除位于根目录下的一个空目录,需要在辅助函数中设置一个标志变量,即:如果删除的是空目录,则置bEmptyDir为True,这一句已经用深色框表示了。
2.1删除目录的递归辅助函数:DoRemoveDir
function DoRemoveDir(sDirName:String):Boolean;
var
hFindFile:Cardinal;
tfile:String;
sCurDir:String;
bEmptyDir:Boolean;
FindFileData:WIN32_FIND_DATA;
begin
//如果删除的是空目录,则置bEmptyDir为True
//初始时,bEmptyDir为True
bEmptyDir:=True;
//先保存当前目录
sCurDir:=GetCurrentDir;
SetLength(sCurDir,Length(sCurDir));
ChDir(sDirName);
hFindFile:=FindFirstFile('*.*',FindFileData);
if hFindFile< >INVALID_HANDLE_VALUE then
begin
repeat
tfile:=FindFileData.cFileName;
if (tfile='.') or (tfile='..') then
begin
bEmptyDir:=bEmptyDir and True;
Continue;
end;
//不是空目录,置bEmptyDir为False
bEmptyDir:=False;
if FindFileData.dwFileAttributes=
FILE_ATTRIBUTE_DIRECTORY then
begin
if sDirName[Length(sDirName)]< >'\' then
DoRemoveDir(sDirName+'\'+tfile)
else
DoRemoveDir(sDirName+tfile);
if not RemoveDirectory(PChar(tfile)) then
result:=false
else
result:=true;
end
else
begin
if not DeleteFile(PChar(tfile)) then
result:=false
else
result:=true;
end;
until FindNextFile(hFindFile,FindFileData)=false;
FindClose(hFindFile);
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
//如果是空目录,则删除该空目录
if bEmptyDir then
begin
//返回上一级目录
ChDir('..');
//删除空目录
RemoveDirectory(PChar(sDirName));
end; //回到原来的目录下
ChDir(sCurDir);
result:=true;
end;
2.2删除目录的函数:DeleteDir
function DeleteDir(sDirName:String):Boolean;
begin
if Length(sDirName)< =0 then
exit;
//删除...
Result:=DoRemoveDir(sDirName) and RemoveDir(sDirName);
end;
3、移动目录
有了拷贝目录和删除目录的函数,移动目录就变得很简单,只需顺序调用前两个函数即可:
function MoveDir(sDirName:String;
sToDirName:string):Boolean;
begin
if CopyDir(sDirName,sToDirName) then
if RemoveDir(sDirName) then
result:=True
else
result:=false;
end;
var
F: TWin32FindData;
Enum: Hwnd;
R: Bool;
FileName: string;
FileSize: Int64;
Magic:integer;
item1:TListItem;
begin
Pointer(Enum) := nil;
with Lview1 do
try
Clear;
Update;
Enum := FindFirstFile(PChar(FLocalPath + '*.*'), F);
R := Pointer(Enum) <> nil;
Magic:=0;
while R do
begin
FileName := F.cFileName;
if filename <>'.' then
begin
item1:=Lview1.Items.Add();
item1.SubItems.Add('');
item1.SubItems.Add('');
item1.SubItems.Add('');
LvAdd(Filename,0,0,item1);
FileSize := (F.nFileSizeHigh shl 32) or (F.nFileSizeLow);
if F.dwFileAttributes and faDirectory = faDirectory then
begin
item1.ImageIndex:=1;
item1.SubItems.Strings[0]:='目录';//文件夹
item1.SubItems.Strings[1]:= '0';
end
else
begin
item1.ImageIndex:=0;
item1.SubItems.Strings[0]:='';//文件夹
item1.SubItems.Strings[1]:= FileSizeToString(FileSize);
item1.SubItems.Strings[2]:=
GetFileTypeDescription(FRemotePath + FileName, True);
end;
end;
R := FindNextFile(Enum, F);
end;
finally
windows.FindClose(Enum);
RemoteSort:=False;
end;
end;function TFTPMain.GetFileTypeDescription(const Name: string; UseAttr: Boolean): string;
var
Info: TSHFileInfo;
Flags: Cardinal;
begin
FillChar(Info, SizeOf(Info), 0);
Flags := SHGFI_TYPENAME;
if UseAttr then Flags := Flags or SHGFI_USEFILEATTRIBUTES;
SHGetFileInfo(PChar(Name), 0, Info, SizeOf(Info), Flags);
Result := Info.szTypeName;
end;function TFTPMain.FileSizeToString(const Size: Int64): string;
var
S: Integer;
begin
if Size < 1024 then
Result := IntToStr(Size) + ' Bytes';
S := Size div 1024;
if S = 0 then S := 1;
if S < 1024 then
Result := IntToStr(S) + ' KB'
else
begin
S := S div 1024;
if S = 0 then S := 1;
Result := IntToStr(S) + ' MB';
end;
end;