思路1:直接使用CopyFile,循环查找文件夹下文件,拷贝到指定目录,(这里测试,不含子目录)
procedure CopyDirectory(SourceDir, DesDir: string);
var
DirInfo: TSearchRec;
r: Integer;
begin
r := FindFirst(SourceDir + '*.*', FaAnyFile, DirInfo);
while r = 0 do
begin
if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
(DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
CopyFile(pchar(SourceDir + DirInfo.Name), pchar(DesDir + DirInfo.Name), True);
r := FindNext(DirInfo);
end;
SysUtils.FindClose(DirInfo);
end;
如果想含有子目录,加一递归即可.
思路2:使用API,TSHFileOpStruct 结构.含有子目录.
procedure CopyFileByFolder(Ahandle: THandle; fromDir,
toDir: String);
var
SHFileOpStruct: TSHFileOpStruct;
pFromDir, pToDir: PAnsiChar;
begin
GetMem(pFromDir, Length(fromDir)+2);
try
GetMem(pToDir, Length(toDir)+2);
try
FillChar(pFromDir^, Length(fromDir)+2, 0);
FillChar(pToDir^, Length(toDir)+2, 0);
StrCopy(pFromDir, PChar(fromDir));
StrCopy(pToDir, PChar(toDir));
with SHFileOpStruct do
begin
Wnd := AHandle; // Assign the window handle
wFunc := FO_COPY; // Specify a file copy
pFrom := pFromDir;
pTo := pToDir;
fFlags := FOF_NOCONFIRMATION or FOF_SILENT;
fAnyOperationsAborted := True;
hNameMappings := nil;
lpszProgressTitle := nil;
if SHFileOperation(SHFileOpStruct) <> 0 then
RaiseLastWin32Error;
end;
finally
FreeMem(pToDir, Length(ToDir)+2);
end;
finally
FreeMem(pFromDir, Length(FromDir)+2);
end;
end;