请问在DELPHI中如何把一个文件拷贝到另外一个文件夹中去?(100分)

  • 主题发起人 主题发起人 dengpangzi
  • 开始时间 开始时间
D

dengpangzi

Unregistered / Unconfirmed
GUEST, unregistred user!
请问在DELPHI中如何把一个文件拷贝到另外一个文件夹中去?
 
检索一下,很多这样的贴子了
 
CopyFile('c:/work/b.mdb','d:/test/a.mdb',false);
 
用CopyFile不就行了?
TargetFile:='c:/aaa.txt';
SourceFile:='d:/bbb.txt';//你要改目录,就可在这儿改字串
CopyFile(PChar(TargetFile),PChar(SourceFile),False);//一个简单例子.
帮助:
The CopyFile function copies an existing file to a new file.

BOOL CopyFile(

LPCTSTR lpExistingFileName, // pointer to name of an existing file
LPCTSTR lpNewFileName, // pointer to filename to copy to
BOOL bFailIfExists // flag for operation if file exists
);


Parameters

lpExistingFileName

Points to a null-terminated string that specifies the name of an existing file.

lpNewFileName

Points to a null-terminated string that specifies the name of the new file.

bFailIfExists

Specifies how this operation is to proceed if a file of the same name as that specified by lpNewFileName already exists. If this parameter is TRUE and the new file already exists, the function fails. If this parameter is FALSE and the new file already exists, the function overwrites the existing file and succeeds.



Return Values

If the function succeeds, the return value is nonzero.
If the function fails, the return value is zero. To get extended error information, call GetLastError.

Remarks

Security attributes for the existing file are not copied to the new file.
File attributes (FILE_ATTRIBUTE_*) for the existing file are copied to the new file. For example, if an existing file has the FILE_ATTRIBUTE_READONLY file attribute, a copy created through a call to CopyFile will also have the FILE_ATTRIBUTE_READONLY file attribute. For further information on file attributes, see CreateFile.
 
楼上这位大侠真是热心人!
 
procedure TForm1.Button1Click(Sender: TObject);
var
ErrorMessage: Pointer; // holds a system error string
ErrorCode: DWORD; // holds a system error code
begin
{blank out the status bar}
StatusBar1.SimpleText:='';

{attempt to copy the file}
if not CopyFile(PChar(Edit1.Text+'/'+ExtractFilename(FileListBox1.FileName)),
PChar(Edit2.Text+'/'+ExtractFilename(FileListBox1.FileName)),

not CheckBox1.Checked) then
begin
{if the file was not copied, display the error message}
ErrorCode := GetLastError;
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
nil, ErrorCode, 0, @ErrorMessage, 0, nil);
StatusBar1.SimpleText:='Error Copying File: '+string(PChar(ErrorMessage));
LocalFree(hlocal(ErrorMessage));
end;
end;

The Tomes of Delphi 3: Win32 Core API Help File by Larry Diehl
 
该结束了吧。
用CopyFile就行了。
 
用API:CopyFile就行了。
 
CCCCCCC.....opyFf...ffff...ile
 
1、使用copyfile,最后一个参数表示如果目标目录中已有该文件名的文件是否覆盖
2、使用SHFileOperation,还能有拷贝进度显示呢,不过要加上shellapi单元
function CopyFile(SourceName,TargetName:String):Boolean;
var
F:TShFileOpStruct;
begin
F.wnd:=InputForm.Handle;
F.wFunc:=FO_COPY; {操作方式}
F.pFrom:=PChar(SourceName+#0#0);
F.pTo:=PChar(TargetName+#0#0);
F.fFlags:=FOF_ALLOWUNDO OR FOF_RENAMEONCOLLISION;
result:= ShFileOperation(F)=0;
end;
 
从《未经证实的葵花宝典》拷贝



---- 1、拷贝目录

---- 为了能拷贝目录下带有子目录的情况,先定义一个辅助的拷贝函数,它是递归执行的,直到把目录下的所有文件和子目录都拷贝完。

---- 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;

---- 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;
不过Delphi5中对FindNextFile函数进行了重写,你自己改以下就行了
function TFileOperation.DoCopyDir(sDirName, sToDirName: String): Boolean;

var
hFindFile:integer;
t,tfile:String;
sCurDir:String[255];
FindFileData:TSearchRec;
begin
//先保存当前目录
sCurDir:=GetCurrentDir;
ChDir(sDirName);
hFindFile:=FindFirst(SdirName+'/*.*',faAnyFile,FindFileData);
if hFindFile=0 then
begin
if not DirectoryExists(sToDirName) then
ForceDirectories(sToDirName);
repeat
tfile:=FindFileData.Name;
if (tfile='.') or (tfile='..') then
Continue;
if FindFileData.attr=faDirectory 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 FindNext(FindFileData)<>0;
FindClose(FindFileData);
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
//回到原来的目录下
ChDir(sCurDir);
result:=true;

end;
 
后退
顶部