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's tutorial作为指导，但任何建议如何改进它使安全线程将不胜感激。

根据答案，我改变了我的代码。这次它奏效了。如果你能再次检讨并告诉我们应该改进什么，我将不胜感激。

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

你有一些问题：

您不会调用继承的Create。在这种情况下，既然你想先做事并自己动手，你应该使用

继承Create（True）; //创建新线程暂停。
您不应该自己致电Execute。如果您创建非暂停，或者致电Resume，则会自动调用。
没有继承的Execute，但无论如何都要调用它。

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

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

Answer 3

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

您有一个无参数构造函数，然后通过线程类属性设置源文件名和目标文件名。只有当您在线程构造函数中完成所有设置时，所有您被告知创建不必要的挂起线程才会成立 - 在此之后，线程执行将开始，并且需要同步对线程属性的访问。您应该（确实是您的第一个代码版本）将两个名称作为参数提供给线程。更糟糕的是：使用具有FreeOnTerminate属性集的线程的唯一安全方法是在构造函数完成后不访问任何属性，因为线程可能已经自行销毁，或者可以在访问财产时进行。
如果出现异常，即使您已设置其FreeOnTerminate属性，也可以释放该线程对象。这可能会导致内存管理器出现双重释放异常。

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

总而言之，如果Ken在his answer中指出，最好使用其中一个带有取消和进度回调的Windows文件复制例程。

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

Answer 4

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

同样在单元fileThread中，在TCopyThread的构造函数中继承Create（True）应该首先调用，以创建一个处于挂起状态的线程。

Answer 5

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

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

在线程中复制文件

5 个答案: