复制目录: ///复制Source整个目录到DEST目录,如果Dest不存在,自动建立,如果DEST存在,那么Source将作为Dest的子目录! //例如如果要复制E:\Temp整个目录到E:\那么代码为: copydirectory('e:\temp','e:\'); ///如果要复制E:\Temp到E:\Test目录下面,那么代码为:CopyDirecotry('E:\Temp','E:\TEST'); 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;
to tyh800220(风林火山): 是不是pFrom和pTo后面要加上#0 ?就象bluemeteor(挂月||╭∩╮(︶_︶)╭∩╮)的代码, 你试试看。
//从源目录复制目录中更新过的文件到目标目录 procedure XCopyNewFiles_Lqb(SourceDir, TargetDir: string); var DirInfo:TSearchRec; IsFound:Integer; FSrc,FTgt:LongInt; begin FSrc:=-1; ExitLoop:=False; IsFound:=FindFirst(SourceDir+'\*.*',FaAnyfile,DirInfo); if not DirectoryExists(TargetDir) then ForceDirectories(TargetDir); while (IsFound=0) and (not ExitLoop) do begin Application.ProcessMessages; if((DirInfo.Attr and FaDirectory)=faDirectory)and(DirInfo.Name<>'.')and(DirInfo.Name<>'..')then XCopyNewFiles_Lqb(SourceDir + '\' + DirInfo.Name, TargetDir + '\' + DirInfo.Name) else if((DirInfo.Attr and FaDirectory)<>faDirectory)then begin FTgt:=FileOpen(TargetDir+'\'+DirInfo.Name,fmShareDenyNone); if FTgt<>-1 then FSrc:=FileOpen(SourceDir+'\'+DirInfo.Name,fmShareDenyNone); if(FTgt=-1)or(FileSeek(FSrc,0,2)<>FileSeek(FTgt,0,2))or(FileGetDate(FSrc)<>FileGetDate(FTgt))then begin if FTgt<>-1 then begin FileClose(FSrc);FileClose(FTgt);end; Tmp_Label.Caption:='正在更新'+IntToStr(Counter)+': '+TargetDir+'\'+DirInfo.Name+'...'; CopyFile(PChar(SourceDir+'\'+DirInfo.Name),PChar(TargetDir+'\'+DirInfo.Name),false); Inc(Counter); end else begin FileClose(FSrc);FileClose(FTgt);end; end; IsFound:=FindNext(DirInfo); end; FindClose(DirInfo); end;调用: XCopyNewFiles_Lqb('c:\temp','c:\temp1');
var shfos: SHFILEOPSTRUCT;
begin
FillChar(shfos, SizeOf(shfos), #0);
with shfos do begin
Wnd := 0;
shfos.wFunc := FO_COPY;
pFrom := PChar(srcDir + '\*.*');
pTo := PChar(destDir);
fFlags := FOF_NOCONFIRMATION+FOF_RENAMEONCOLLISION+FOF_SILENT;
fAnyOperationsAborted := False;
end;
try
SHFileOperation(shfos);
Result := True;
except
Result := False;
end;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
CopyDir('d:\temp', 'd:\temp1');
end;
///复制Source整个目录到DEST目录,如果Dest不存在,自动建立,如果DEST存在,那么Source将作为Dest的子目录!
//例如如果要复制E:\Temp整个目录到E:\那么代码为: copydirectory('e:\temp','e:\');
///如果要复制E:\Temp到E:\Test目录下面,那么代码为:CopyDirecotry('E:\Temp','E:\TEST');
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;
是不是pFrom和pTo后面要加上#0 ?就象bluemeteor(挂月||╭∩╮(︶_︶)╭∩╮)的代码,
你试试看。
procedure XCopyNewFiles_Lqb(SourceDir, TargetDir: string);
var
DirInfo:TSearchRec;
IsFound:Integer;
FSrc,FTgt:LongInt;
begin
FSrc:=-1;
ExitLoop:=False;
IsFound:=FindFirst(SourceDir+'\*.*',FaAnyfile,DirInfo);
if not DirectoryExists(TargetDir) then ForceDirectories(TargetDir);
while (IsFound=0) and (not ExitLoop) do
begin
Application.ProcessMessages;
if((DirInfo.Attr and FaDirectory)=faDirectory)and(DirInfo.Name<>'.')and(DirInfo.Name<>'..')then
XCopyNewFiles_Lqb(SourceDir + '\' + DirInfo.Name, TargetDir + '\' + DirInfo.Name)
else
if((DirInfo.Attr and FaDirectory)<>faDirectory)then
begin
FTgt:=FileOpen(TargetDir+'\'+DirInfo.Name,fmShareDenyNone);
if FTgt<>-1 then FSrc:=FileOpen(SourceDir+'\'+DirInfo.Name,fmShareDenyNone);
if(FTgt=-1)or(FileSeek(FSrc,0,2)<>FileSeek(FTgt,0,2))or(FileGetDate(FSrc)<>FileGetDate(FTgt))then
begin
if FTgt<>-1 then begin FileClose(FSrc);FileClose(FTgt);end;
Tmp_Label.Caption:='正在更新'+IntToStr(Counter)+': '+TargetDir+'\'+DirInfo.Name+'...';
CopyFile(PChar(SourceDir+'\'+DirInfo.Name),PChar(TargetDir+'\'+DirInfo.Name),false);
Inc(Counter);
end
else
begin FileClose(FSrc);FileClose(FTgt);end;
end;
IsFound:=FindNext(DirInfo);
end;
FindClose(DirInfo);
end;调用:
XCopyNewFiles_Lqb('c:\temp','c:\temp1');