delphi复制文件夹并覆盖-要求必须覆盖的
2010或者其它版本的就不要写了
希望测试后再发布，谢谢了！
要能覆盖的可以吗？ 展开
使用下面的函数即可，此函数使用了SHFileOperation API函数。代码如下：
Function Copy_Dir(SourceDir,DestDir:String;nLx:Integer):Boolean;
Var
Opstruc: TshFileOpStruct;
frombuf,tobuf: Array[0..128] of Char;
begin
FillChar(frombuf,Sizeof(frombuf),0);
FillChar(tobuf,Sizeof(tobuf),0);
StrPcopy(frombuf,SourceDir);
Case nLx of
1:
StrPcopy(tobuf,DestDir);
end;
With Opstruc Do
Begin
Wnd:=0;
Case nLx of
1: wFunc:=FO_COPY;
2: wFunc:=FO_DELETE;
Else wFunc:=FO_COPY;
end;
pFrom:=@frombuf;
pTo:=@tobuf;
fFlags:=FOF_NOCONFIRMATION;
fAnyOperationsAborted:=False;
hNameMappings:=Nil;
lpszProgressTitle:=Nil;
end;
try
ShFileOperation(OpStruc);
Result:=True;
except
Result:=False;
end;
end;
需要引用单元uses shellapi;
测试代码：
Copy_Dir('c:\aa','d:\',1 );
SHFileOperation函数说明
函数功能描述:文件操作，与 Shell 的动作相同.
函数原型：
#include<shellapi.h>
WINSHELLAPI int WINAPI SHFileOperation(LPSHFILEOPSTRUCT
lpFileOp);
参数：
typedef struct _SHFILEOPSTRUCT
{
HWND
hwnd; //父窗口句柄
UINT
wFunc; //要执行的动作
LPCTSTR
pFrom;
//源文件路径，可以是多个文件
LPCTSTR
pTo;
//目标路径，可以是路径或文件名
FILEOP_FLAGS
fFlags; //标志，附加选项
BOOL
fAnyOperationsAborted; //是否可被中断
LPVOID
hNameMappings;
//文件映射名字，可在其它 Shell 函数中使用
LPCTSTR
lpszProgressTitle; // 只在 FOF_SIMPLEPROGRESS
时，指定对话框的标题。
} SHFILEOPSTRUCT, FAR *LPSHFILEOPSTRUCT;
wFunc 可以为：
/FO_MOVE
0x0001 移动文件
FO_COPY
0x0002 复制文件
FO_DELETE
0x0003 删除文件，只使用 pFrom
FO_RENAME
0x0004 文件重命名
fFlags可以为：
FOF_MULTIDESTFILES
0x0001 //pTo
指定了多个目标文件，而不是单个目录
FOF_CONFIRMMOUSE
0x0002
FOF_SILENT
0x00044 // 不显示一个进度对话框
FOF_RENAMEONCOLLISION
0x0008 //
碰到有抵触的名字时，自动分配前缀
FOF_NOCONFIRMATION
0x0010 // 不对用户显示提示
FOF_WANTMAPPINGHANDLE
0x0020 // 填充 hNameMappings
字段，必须使用 SHFreeNameMappings 释放
FOF_ALLOWUNDO
0x0040 // 允许撤销
FOF_FILESONLY
0x0080 // 使用 *.* 时, 只对文件操作
FOF_SIMPLEPROGRESS
0x0100 //
简单进度条，意味者不显示文件名。
FOF_NOCONFIRMMKDIR
0x0200 //
建新目录时不需要用户确定
FOF_NOERRORUI
0x0400 // 不显示出错用户界面
FOF_NOCOPYSECURITYATTRIBS
0x0800 // 不复制 NT 文件的安全属性
FOF_NORECURSION
0x1000 // 不递归目录
返回值：
函数成功返回 0 ，失败返回非 0 。
CopyFile(PChar(源文件名),PChar(目标文件名),False);
该函数不会提示要不要覆盖，最后一个参数取值为False就直接覆盖，取值为True，如果目标文件已存在就直接放弃，并返回0；复制成功函数返回非0。
首先谢谢你的回答！
我要复制的是文件夹呀！
你这个是复制文件的
procedure DeleteTree(DirName: String);
var
SearchRec: TSearchRec;
FileName: string;
rc, attr: integer;
begin
rc := FindFirst(DirName+'\*.*', faAnyFile, SearchRec);
while rc=0 do
begin
FileName := DirName + '\' + SearchRec.Name;
attr := SearchRec.Attr;
if (SearchRec.Name<>'.') and (SearchRec.Name<>'..')then
if (Attr and faDirectory) > 0 then
DeleteTree(FileName)
else
begin
FileSetAttr(FileName, faArchive);
DeleteFile(FileName);
end;
rc := FindNext(SearchRec);
end;
FindClose(SearchRec);
RemoveDir(DirName);
end;
这个是删除删除整个文件夹的，要用递归算法，稍改一下就能复制文件夹，如果你懂得递归算法，加上使用前面回答的那个函数，你应该自己能够做到。
找到到原来自己写的复制文件夹的函数，一起给你了，直接提交不上，放附件里了。
Var
Opstruc: TshFileOpStruct;
frombuf,tobuf: Array[0..128] of Char;
begin
FillChar(frombuf,Sizeof(frombuf),0);
FillChar(tobuf,Sizeof(tobuf),0);
StrPcopy(frombuf,SourceDir);
Case nLx of
1:
StrPcopy(tobuf,DestDir);
end;
With Opstruc Do
Begin
Wnd:=0;
Case nLx of
1: wFunc:=FO_COPY;
2: wFunc:=FO_DELETE;
Else wFunc:=FO_COPY;
end;
pFrom:=@frombuf;
pTo:=@tobuf;
fFlags:=FOF_NOCONFIRMATION;
fAnyOperationsAborted:=False;
hNameMappings:=Nil;
lpszProgressTitle:=Nil;
end;
try
ShFileOperation(OpStruc);
Result:=True;
except
Result:=False;
end;
end;
哥们，这个不行的！他不覆盖呀！我想要覆盖的！
就是执行多少次都覆盖文件夹包括里面文件那种的！
|
广告 您可能关注的内容 |
