备份文件。
var
p : SHFILEOPSTRUCT ;
str : string;
begin
str:=GetCurrentDir();
p.pFrom :=pchar(str+'\*.*');
showmessage(p.pFrom);
p.pTo :=pchar(str+'\backup\');
showmessage(p.pTo);
p.wFunc :=FO_COPY;
p.Wnd :=Handle;
p.lpszProgressTitle:= '请等待...';
{设定操作选项}
p.fFlags:= FOF_ALLOWUNDO or FOF_NOCONFIRMMKDIR
or FOF_NOCONFIRMATION or FOF_FILESONLY ;
try
SHFileOperation(p);
except
messagedlg('备份文件出错!',mtError,[mbOk],0);
exit;
end;end;
var
p : SHFILEOPSTRUCT ;
str : string;
begin
str:=GetCurrentDir();
p.pFrom :=pchar(str+'\*.*');
showmessage(p.pFrom);
p.pTo :=pchar(str+'\backup\');
showmessage(p.pTo);
p.wFunc :=FO_COPY;
p.Wnd :=Handle;
p.lpszProgressTitle:= '请等待...';
{设定操作选项}
p.fFlags:= FOF_ALLOWUNDO or FOF_NOCONFIRMMKDIR
or FOF_NOCONFIRMATION or FOF_FILESONLY ;
try
SHFileOperation(p);
except
messagedlg('备份文件出错!',mtError,[mbOk],0);
exit;
end;end;
解决方案 »
- [新手求助]dbgrid中插入记录时的问题
- DBGrid里面显示的每条记录,都对应的显示有不同的Hint(提示信息),请问这是怎么实现的?
- 如何卸载掉已经安装的自定义组件?
- 如何取得屏目上某点的颜色?在线等qq66639527
- 不懂
- 请问如何修改将一时间字段的值置为空???
- 菜鸟问题若干请高手解答,我在线等待!
- delphi程序员的工资有多少?与其他vb或c++以及java程序员相比较谁最高?
- 关于QuickRep的问题,怎么才能将Memo中的内容赋给QRMemo呢?
- 如何知道Delphi中ADO控件是否升级了补丁?
- 制作安装文件,再现等待?
- 老大们:::谁知道Serv-U怎么使用呀???看了一大堆使用文章,还是不会用:((((
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 TForm1.Button2Click(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, 'd:\brief\*.*' );
StrPCopy( tobuf, 'd:\temp\brief' );
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;
function CopyDirectory(const Source, Dest: string): boolean;
var
fo: TSHFILEOPSTRUCT;
begin
FillChar(fo, SizeOf(fo), 0);
with fo do
begin
Wnd := 0;
wFunc := FO_COPY;
pFrom := PChar(source+#0);
pTo := PChar(Dest+#0);
fFlags := FOF_NOCONFIRMATION+FOF_NOCONFIRMMKDIR ;
end;
Result := (SHFileOperation(fo) = 0);
end;
function CopyDirectory(const Source, Dest: string): boolean;
var
fo: TSHFILEOPSTRUCT;
begin
FillChar(fo, SizeOf(fo), 0);
with fo do
begin
Wnd := 0;
wFunc := FO_COPY;
pFrom := PChar(source+#0);
pTo := PChar(Dest+#0);
fFlags := FOF_NOCONFIRMATION+FOF_NOCONFIRMMKDIR ;
end;
Result := (SHFileOperation(fo) = 0);
end;