delphi中如何实现多个文件拷贝。

Question

小弟我正做一个项目，想在一个目录下选择多个文件，把它们一起拷贝到一个临时文件夹内。
在线等待，请各位大侠帮帮忙。

Answer 1

可以使用API函数SHFileOperation。

Answer 2

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls;type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Button1: TButton;
    Label3: TLabel;
    Label4: TLabel;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function CopyDir(sDirName:String;sToDirName:string):Boolean;
     function DoCopyDir(sDirName:String;sToDirName:String):Boolean;
  end;var
  Form1: TForm1;implementation
{$R *.dfm}function TForm1.CopyDir(sDirName:String;sToDirName:string):Boolean;
begin
if Length(sDirName)<=0  then
   exit;
//拷贝...
 Result:=DoCopyDir(sDirName,sToDirName);
end;function Tfrmmain.DoCopyDir(sDirName:String;sToDirName:String):Boolean;
  var
    sr:TsearchRec;
    hFind:Cardinal;
    t,tfile:String;
    sCurDir:String[255];
    FindFileData:WIN32_FIND_DATA;
    Attrs:Integer;
  begin
  //先保存当前目录
    sCurDir:=GetCurrentDir;
    try
    ChDir(sDirName);//改变当前目录为‘SDirName’
    except
    exit;
    end;
     //showmessage(sdirname);
    hFind:=FindFirstfile('*.*',FindFileData);//把找到的第一个文件赋给hfindFile
    if hFind<>INVALID_HANDLE_VALUE  then
      begin
        if not DirectoryExists(sToDirName) then
          ForceDirectories(sToDirName); //判断目标目录是否存在，如果不存在，则创建该多级目录
        repeat
          t:=FindFileData.cFileName; //搜索所在目录下的所有文件
          if (t='.') or (t='..')then
            Continue;
          if (FindFileData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)>0 then
            begin
              t:=sToDirName+'\'+tfile;
              if not DirectoryExists(t) then
                ForceDirectories(t); //判断目录是否存在，如果没有则建立目录
              //if sDirName[Length(sDirName)]<>'\' then
               // begin
                DoCopyDir(sDirName+'\'+tfile,t);//如果路径后不带'\'，则需加上
                 Attrs:=FileGetAttr(sDirName+'\'+tfile);
                 FileSetAttr(t,Attrs);
                // end
             // else
               // begin
               // DoCopyDir(sDirName+tfile,sToDirName+tfile);
               //  Attrs:=FileGetAttr(sDirName+tfile);
               //  FileSetAttr(t,Attrs);
             //    end;
            end
          else
            begin
                t:=sToDirName+'\'+tFile;
                CopyFile(PChar(tfile),PChar(t),True);
            end;
         Label4.Caption :=t;
         Label4.Update ;
         until FindNextFile(hFind,FindFileData)=false;
           //FindClose(hFindFile);
      end
    else
      begin
        ChDir(sCurDir);
        result:=false;
        exit;
      end;
  //回到原来的目录下
  ChDir(sCurDir);
  result:=true;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ProgressBar1.Max:=1000;
ProgressBar1.Position :=0;
if CopyDir(edit1.Text ,edit2.Text ) then
 begin//1
  Showmessage('ok'); end;//1
ProgressBar1.Position :=0;
end;end.