在一个线程中复制文件 [英] copy file in a thread

问题描述

我正在尝试通过调用单独的线程来写文件以进行复制. 这是我的表单代码:

I am trying to write to copy a file by invoking a separate thread. Here is my form code:

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.

运行应用程序时，出现以下错误:

When I run the application, I received a following error:

项目prjFileCopyThread引发异常类EThread，并显示消息:无法在正在运行或已暂停的线程上调用Start".

Project prjFileCopyThread raised exception class EThread with message: 'Cannot call Start on a running or suspended thread'.

我没有线程经验. 我使用马丁·哈维的教程作为指导，但是任何建议改进它使安全线程将不胜感激.

I do not have experience with threads. I use Martin Harvey's tutorial as a guide, but any advice how to improve it make safe thread would be appreciated.

根据答案，我更改了代码.这次它起作用了.如果您可以再次查看并告知需要改进的地方，我们将不胜感激.

Based on the answers, I've changed my code. This time it worked. I would appreciate if you can review it again and tell what should be improved.

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.

推荐答案

仅作比较-这就是您使用

Just for comparison - that's how you'd do it with 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;

这篇关于在一个线程中复制文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！