盒子论坛 v2.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;
拷贝目录的函数:CopyDir
function CopyDir(sDirName:String;
sToDirName:string):Boolean;
begin
      if Length(sDirName)< =0 then
         exit;
      //拷贝...
      Result:=DoCopyDir(sDirName,sToDirName);
end;

----------------------------------------------
-

作者：

boy (阿門)	★☆☆☆☆	-
	盒子活跃会员

2003/4/10 11:19:44

4楼：

試試看
最簡單的作法是直接呼叫 CopyFile 這個 API,
但注意d:\AAA\須要有此目錄例如:

procedure TForm1.Button1Click(Sender: TObject);
var
  sFromFileName, sToFileName: AnsiString;
begin
  sFromFileName := 'C:aa.htm';
  sToFileName := 'd:\AAA\aa.htm';
  if Windows.CopyFile(pchar(sFromFileName), pchar(sToFileName), False) then
    ShowMessage('檔案複製完成')
  else
    ShowMessage('發生錯誤: ' + IntToStr(GetLastError));
end;

其次, 應用 TFileStream 來作也是可以的, 以下是寫好的函數:
function StreamCopyFile(const sInFileName, sOutFileName: string): boolean;
var
  InStream, OutStream: TFileStream;
begin
  Result := False;
  InStream := TFileStream.Create(sInFileName,
    fmOpenRead or fmShareDenyWrite);
  try
    OutStream := TFileStream.Create(sOutFileName,
      fmCreate or fmOpenWrite);
    try
      OutStream.CopyFrom(InStream, 0);
    finally
      OutStream.Free;
    end;
  finally
    InStream.Free;
  end;
  Result := True;
end;

不然, 自己用 BlockRead & BlockWrite 讀寫資料也可以吧! :p
--------------------------------------------------------

function StreamCopyFile(const sInFileName, sOutFileName: string): boolean;
var
  InStream, OutStream: TFileStream;
begin
  Result := False;
  InStream := TFileStream.Create(sInFileName,
    fmOpenRead or fmShareDenyWrite);
  try
    OutStream := TFileStream.Create(sOutFileName,
      fmCreate or fmOpenWrite);
    try
      OutStream.CopyFrom(InStream, 0);
    finally
      OutStream.Free;
    end;
  finally
    InStream.Free;
  end;
  Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  sFromFileName, sToFileName: AnsiString;
begin
  sFromFileName := 'd:\Cedit.ini';//來源檔
  sToFileName := 'd:\AAA\Cedit.ini'; //目的檔
  if Windows.CopyFile(pchar(sFromFileName), pchar(sToFileName), False) then
    ShowMessage('檔案複製完成')
  else
    ShowMessage('發生錯誤: ' + IntToStr(GetLastError));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if StreamCopyFile('d:Ce1.ful','d:\AAA\Ce11.ful') then
//                   ^^^^^^來源檔 ^^^^^^^^^目的檔
    ShowMessage('檔案複製完成')
  else
    ShowMessage('發生錯誤: ' + IntToStr(GetLastError));
end;

----------------------------------------------
Delphi開發◆伺服器架設◆免安裝APACHE,PHP,CGI Perl, MYSQL ★

作者：

dnlidj (平淡是真)	★☆☆☆☆	-
	普通会员

2003/4/24 20:45:05

5楼：

三楼的兄弟，有行代码错了
FindClose(hFindFile);
应该改为：fileclose(hfindfile);
----------------------------------------------
平平淡淡才最真

作者：

leakboy (风裂)	★☆☆☆☆	-
	盒子活跃会员

2003/4/26 18:35:16

6楼：

DOS命令懂么，调用DOS好了！
----------------------------
implementation

{$R *.dfm}

function WinExecAndWait32(FileName:String; Visibility : integer): DWORD;
var
zAppName:array[0..512] of char;
zCurDir:array[0..255] of char;
WorkDir:String;
StartupInfo:TStartupInfo;
ProcessInfo:TProcessInformation;
begin
StrPCopy(zAppName,FileName);
GetDir(0,WorkDir);
StrPCopy(zCurDir,WorkDir);
FillChar(StartupInfo,Sizeof(StartupInfo),#0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := Visibility;
if not CreateProcess(
nil,
zAppName, { pointer to command line string }
nil, { pointer to process security attributes }
nil, { pointer to thread security attributes }
false, { handle inheritance flag }
CREATE_NEW_CONSOLE or { creation flags }
NORMAL_PRIORITY_CLASS,
nil, { pointer to new environment block }
nil, { pointer to current directory name }
StartupInfo, { pointer to STARTUPINFO }
ProcessInfo { pointer to PROCESS_INF }
)
then Result := $FFFFFFFF else begin
WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess,Result);
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
WinExecAndWait32('COMMAND.COM /C COPY c:\*.* c:\windows\20030331',SW_NORMAL);
showmessage('拷贝成功！');
end;

----------------------------------------------
My name is leakboy.

作者：

wuguang402 (卡卡)	★☆☆☆☆	-
	盒子活跃会员

2006/4/24 20:27:01

7楼：

MoveFileEx() 函数就可以了
----------------------------------------------
-

作者：

knight258 (浪子天涯)	★☆☆☆☆	-
	普通会员

2007/2/13 9:29:14

8楼：

编写个批处理文件，直接用程序打开此文件不更好
----------------------------------------------
-

信息

登陆以后才能回复