转贴两个方法,旧帖里有很多的。
1。
uses ..., ShellAPI
procedure TForm1.Button1Click(Sender: TObject);
var
OpStruc: TSHFileOpStruct;
frombuf, tobuf: Array [0..128] of Char;
Begin
FillChar( frombuf, Sizeof(frombuf), 0 );
FillChar( tobuf, Sizeof(tobuf), 0 );
StrPCopy( frombuf, 'c:/a' );
StrPCopy( tobuf, 'c:/b' );
With OpStruc DO Begin
Wnd:= Handle;
wFunc:= FO_COPY;
pFrom:= @frombuf;
pTo:=@tobuf;
fFlags:= FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
fAnyOperationsAborted:= False;
hNameMappings:= Nil;
lpszProgressTitle:= Nil;
end;
ShFileOperation( OpStruc );
end;
2。
---- 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;