在线程中复制文件

Question

我试图通过调用一个单独的线程来复制文件.这是我的表单代码:

unit frmFileCopy;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls;

type
  TForm2 = class(TForm)
    Button3: TButton;
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    ThreadNumberCounter : integer;
    procedure HandleTerminate (Sender: Tobject);

  end;

var
  Form2: TForm2;

implementation

uses
  fileThread;

{$R *.dfm}

{ TForm2 }
const
  sourcePath = 'source\'; //'
  destPath =  'dest\'; //'
  fileSource = 'bigFile.zip';
  fileDest = 'Copy_bigFile.zip';

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := true;
  if ThreadNumberCounter >0 then
  begin
    if MessageDlg('The file is being copied. Do you want to quit?', mtWarning, 
                  [mbYes, mbNo],0) = mrNo then
      CanClose := false;
  end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  ThreadNumberCounter := 0;
end;

procedure TForm2.Button3Click(Sender: TObject);
var
  sourceF, destF : string;
  copyFileThread : TCopyThread;
begin
  sourceF := ExtractFilePath(ParamStr(0))  + sourcePath + fileSource;
  destF := ExtractFilePath(ParamStr(0))  + sourcePath + fileDest;

  copyFileThread := TCopyThread.create(sourceF,destF);
  copyFileThread.FreeOnTerminate := True;
  try
    Inc(ThreadNumberCounter);
    copyFileThread.Execute;
    copyFileThread.OnTerminate := HandleTerminate;
    copyFileThread.Resume;
  except
    on Exception do
    begin
      copyFileThread.Free;
      ShowMessage('Error in thread');
    end;
  end;
end;

procedure TForm2.HandleTerminate(Sender: Tobject);
begin
  Dec(ThreadNumberCounter);
end;

这是我的班级:

unit fileThread;

interface

uses
  Classes, SysUtils;

type
  TCopyThread = class(TThread)
  private
    FIn, FOut : string;
    procedure copyfile;
  public
    procedure Execute ; override;
    constructor create (const source, dest : string);
  end;

implementation

{ TCopyThread }

procedure TCopyThread.copyfile;
var
  streamSource, streamDest : TFileStream;
  bIn, bOut : byte;
begin
  streamSource := TFileStream.Create(FIn, fmOpenRead);
  try
    streamDest := TFileStream.Create(FOut,fmCreate);
    try
      streamDest.CopyFrom(streamSource,streamSource.Size);
      streamSource.Position := 0;
      streamDest.Position := 0;
      {check file consinstency}
      while not (streamSource.Position = streamDest.Size) do
      begin
        streamSource.Read(bIn, 1);
        streamDest.Read(bOut, 1);
        if bIn <> bOut then
          raise Exception.Create('files are different at position' +
                                 IntToStr(streamSource.Position));
      end;      
    finally
      streamDest.Free;
    end;
  finally
    streamSource.Free;
  end;
end;

constructor TCopyThread.create(const source, dest: string);
begin
  FIn := source;
  FOut := dest;
end;

procedure TCopyThread.Execute;
begin
  copyfile;
  inherited;
end;

end.

当我运行该应用程序时,我收到以下错误:

项目prjFileCopyThread引发异常类EThread,并显示以下消息:'无法在正在运行或挂起的线程上调用Start'.

我没有线程经验.我使用Martin Harvey的教程作为指导,但任何建议如何改进它使安全线程将不胜感激.

---

根据答案,我改变了我的代码.这次它奏效了.如果您能再次查看并告诉我们应该改进哪些内容,我将不胜感激.

procedure TForm2.Button3Click(Sender: TObject);
var
  sourceF, destF : string;
  copyFileThread : TCopyThread;
begin
  sourceF := ExtractFilePath(ParamStr(0))  + sourcePath + fileSource;
  destF := ExtractFilePath(ParamStr(0))  + destPath + fileDest;

  copyFileThread := TCopyThread.create;

  try
    copyFileThread.InFile := sourceF;
    copyFileThread.OutFile := destF;

  except
    on Exception do
    begin
      copyFileThread.Free;
      ShowMessage('Error in thread');
    end;
  end;

这是我的班级:

type
  TCopyThread = class(TThread)
  private
    FIn, FOut : string;
    procedure setFin (const AIN : string);
    procedure setFOut (const AOut : string);
    procedure FCopyFile;
  protected
    procedure Execute ; override;
  public
    constructor Create;
    property InFile : string write setFin;
    property OutFile : string write setFOut;
  end;

implementation

{ TCopyThread }

procedure TCopyThread.FCopyfile;
var
  streamSource, streamDest : TFileStream;
  bIn, bOut : byte;
begin
  {removed the code to make it shorter}
end;

procedure TCopyThread.setFin(const AIN: string);
begin
  FIn := AIN;
end;

procedure TCopyThread.setFOut(const AOut: string);
begin
  FOut := AOut;
end;

constructor TCopyThread.create;
begin
  FreeOnTerminate := True;
  inherited Create(FALSE);
end;

procedure TCopyThread.Execute;
begin
  FCopyfile;
end;

end.

Answer 1

你有一些问题:

1. 你不称为继承Create.在这种情况下,既然你想先做事并自己动手,你应该使用

   继承Create(True); //创建新线程暂停.

2. 你永远不应该打电话给Execute自己 如果您创建非暂停,或者您打电话,它会自动调用Resume.

3. 没有继承Execute,但无论如何你都称之为.

顺便说一句,你也可以使用内置的Windows Shell函数SHFileOperation来进行复制.它将在后台运行,处理多个文件和通配符,并可以自动向用户显示进度.您可以在SO上找到在Delphi中使用它的示例; 例如,这是一个用于递归删除文件的链接.

SO上的一个很好的搜索是(没有引号) shfileoperation [delphi]

Answer 2

只是为了比较 - 这就是你用OmniThreadLibrary做的.

uses
  OtlCommon, OtlTask, OtlTaskControl;

type
  TForm3 = class(TForm)
    ...
    FCopyTask: IOmniTaskControl;
  end;

procedure BackgroundCopy(const task: IOmniTask);
begin
  CopyFile(PChar(string(task.ParamByName['Source'])), PChar(string(task.ParamByName['Dest'])), true);
  //Exceptions in CopyFile will be mapped into task's exit status
end;

procedure TForm3.BackgroundCopyComplete(const task: IOmniTaskControl);
begin
  if task.ExitCode = EXIT_EXCEPTION then
    ShowMessage('Exception in copy task: ' + task.ExitMessage);
  FCopyTask := nil;
end; 

procedure TForm3.Button3Click(Sender: TObject);
begin
  FCopyTask := CreateOmniTask(BackgroundCopy)
    .SetParameter('Source', ExtractFilePath(ParamStr(0))  + sourcePath + fileSource)
    .SetParameter('Dest', ExtractFilePath(ParamStr(0))  + destPath + fileDest)
    .SilentExceptions
    .OnTerminate(BackgroundCopyComplete)
    .Run;
end;

procedure TForm3.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := true;
  if assigned(FCopyTask) then
  begin
    if MessageDlg('The file is being copied. Do you want to quit?', mtWarning, 
                  [mbYes, mbNo],0) = mrNo then
      CanClose := false
    else
      FCopyTask.Terminate;    
  end;
end;