Multithreading 在线程中复制文件

我试图通过调用一个单独的线程来编写和复制一个文件。 这是我的表格代码：

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.

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.

这是我的班级：

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.

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.

---

执行线程，然后在线程运行时尝试恢复它

copyFileThread.Execute;
copyFileThread.OnTerminate := HandleTerminate;
copyFileThread.Resume;

---

线程的Execute方法通常不会由客户机代码显式调用。换句话说：删除CopyFileThread。在单元frmFileCopy中执行。当调用Resume方法时，线程启动

---

此外，应首先调用TCopyThread继承创建（True）构造函数中的unit fileThread，以创建处于挂起状态的线程。

您有几个问题：

您不调用继承的

Create

。在这种情况下，由于您想先做一些事情，然后自己开始，所以应该使用

继承的创建（True）；//创建挂起的新线程

你不应该自己调用

Execute

。如果创建非挂起，或者调用

Resume

，则会自动调用该函数

没有继承的

Execute

，但您仍可以调用它

顺便说一句，您还可以使用内置的Windowsshell函数进行复制。它将在后台工作，处理多个文件和通配符，并能自动向用户显示进度。您可能会在这里找到一个在Delphi中使用它的示例；例如，是用于递归删除文件的链接

---

在这里搜索SO is（不带引号）

shfileoperation[delphi]

您编辑的代码至少还有两个大问题：

• 您有一个无参数构造函数，然后通过线程类属性设置源文件名和目标文件名。仅当您在线程构造函数中执行所有设置时，您被告知创建挂起的线程是不必要的，并且只有在完成所有设置后，线程才会开始执行，并且需要同步对线程属性的访问。您应该（就像第一个版本的代码一样）将这两个名称作为线程的参数。更糟糕的是：使用带有

  FreeOnTerminate

  属性集的线程的唯一安全方法是，一旦构造函数完成，就不要访问任何属性，因为线程可能已经销毁了自己，或者在访问属性时可以这样做

• 如果出现异常，则释放线程对象，即使已设置其

  FreeOnTerminate

  属性。这可能会导致内存管理器出现双重空闲异常

我还想知道你想如何知道文件复制何时完成——如果没有异常，按钮点击处理程序将退出，线程仍在后台运行。也没有办法取消正在运行的线程。这将导致应用程序仅在线程完成时退出

总之，正如Ken在中指出的，您最好使用带有取消和进度回调的Windows文件复制例程之一

---

如果您这样做只是为了试验线程——不要在测试中使用文件操作，它们是不匹配的，原因有几个，不仅因为在主线程中有更好的方法来做同样的事情，而且因为如果不尝试并发操作，I/O带宽将得到最佳利用（这意味着：不要试图通过创建多个线程来并行复制多个文件）。

只是为了进行比较——这就是您使用的方法

---

代码工作正常，我能够复制文件。但是，当我试图关闭表单时，我从formCloseQuery收到一条消息，“文件正在复制…”。尽管我验证了文件已经在目标文件夹中。我遗漏了一些内容。//--更新的代码----Inc（ThreadNumberCounter）；copyFileThread.OnTerminate:=HandletTerminate；copyFileThread.Resume；和类中继承的Create（True）；任何可能出现问题的想法……Martin Harvey的文档在十年前写的时候非常好，但是事情已经向前发展了，如果特别是使用Delphi 2010，你需要对线程的启动方式进行一些更改。事情并没有真正向前发展，Frogb。唯一要做的更改是调用start当然，如果你想创建一个挂起的线程的话（没有什么理由）我很确定忽略继承的构造函数是一个致命的问题。这就是操作系统线程被分配的地方。事实上，这可能是Greener看到的异常的根本原因。没有操作系统线程，所以挂起计数是它的默认值零。当他调用Resume时，它认为它已经恢复，所以抛出。从Delphi 6开始，我试想，创建不挂起的线程是完全安全的；在构造函数完成运行之前，线程不会开始运行。此外，还有一个继承的执行，但它是抽象的。我认为，在Delphi 5中，编译器会自动忽略对继承的抽象方法的调用，因此Greener代码中的这一行没有问题。它是没必要，但没什么问题。伙计们，我已经根据你们的评论修改了我的代码。这次成功了。如果你们能再看一遍，告诉我应该改进什么，我将不胜感激。ChrisNo，这不是那些行的意思。他调用Execute，所以它在调用它的线程中运行，就像其他任何方法一样。当它完成时shed，control返回给调用方，调用方设置OnTerminate方法，然后恢复线程。如果类的其余部分编写正确，则线程将开始运行，并将再次复制文件。我建议完全放弃该异常处理程序。它不处理任何异常。它只报告它和n假装一切正常。这可能只是因为他在线程开始运行后设置文件名属性时遇到问题。谢谢大家，我计划在实际项目中使用它。代码