如何安全地从另一个线程检查主线程标志？

Question

我在网上找到了这段代码，它可以工作，但我不确定从另一个线程直接读取主线程中的变量是否可以。在这个例子中，标志（变量）是 CancelCopy。一般来说，我想知道如何在另一个线程中立即从主线程读取变量的状态，而无需等待。

type
  TCopyEx = packed record
    Source: String;
    Dest: String;
    Handle: THandle;
  end;
  PCopyEx = ^TCopyEx;

const
  CFEX_CANCEL          = WM_USER + 1;

var
  CancelCopy:Boolean=False;

function CopyFileProgress(TotalFileSize, TotalBytesTransferred, StreamSize,
   StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber, dwCallbackReason: DWORD;
   hSourceFile, hDestinationFile: THandle; lpData: Pointer): DWORD; stdcall;
begin
 if CancelCopy then begin
  SendMessage(THandle(lpData), CFEX_CANCEL, 0, 0);
  result:=PROGRESS_CANCEL;
  Exit;
 end;
 //rest of the code here.......
end;

function CopyExThread(p: PCopyEx):Integer;
var
  Source: String;
  Dest: String;
  Handle: THandle;
  Cancel: PBool;
begin
 Source:=p.Source;
 Dest:=p.Dest;
 Handle:=p.Handle;
 Cancel:=PBOOL(False);
 CopyFileEx(PChar(Source), PChar(Dest), @CopyFileProgress, Pointer(Handle), Cancel, COPY_FILE_NO_BUFFERING);
 Dispose(p);
 result:=0;
end;

procedure TFormMain.ButtonCopyClick(Sender: TObject);
var
  Params: PCopyEx;
  ThreadID: Cardinal;
begin
  cancelCopy := False;
  New(Params);
  Params.Source := EditOriginal.Text;
  Params.Dest := EditCopied.Text;
  Params.Handle := Handle;
  CloseHandle(BeginThread(nil, 0, @CopyExThread, Params, 0, ThreadID));
end;

procedure TFormMain.ButtonCancelClick(Sender: TObject);
begin
  cancelCopy := true;
end;

Answer 1

从技术上讲，您显示的代码没有问题，并且会按预期工作。

不过，里面有个小错误。您将错误的指针值传递给 CopyFileEx() 的 pbCancel 参数。但是，您的代码不会崩溃，因为您传递的指针实际上被设置为 nil，并且 pbCancel 将接受 nil 指针，因此 CopyFileEx() 将忽略参数.

你应该做的是传递一个BOOL变量的地址，你可以随时将其设置为TRUE以取消复制。 CopyFileEx() 将为您监视该变量，您无需在设置变量时从回调中手动 return PROGRESS_CANCEL（return PROGRESS_CANCEL 如果您的回调遇到与复制本身无关的错误，并且您希望由于错误而中止复制）。不过，我不会为此使用全局变量。我会使用执行复制的表单的本地变量。

尝试更像这样的东西：

type
  TFormMain = class(TForm)
    ...
  private
    CancelCopy: BOOL; // <-- BOOL, not Boolean
    ...
  end;

...

type
  TCopyEx = record
    Source: String;
    Dest: String;
    Handle: HWND;
    PCancelCopy: PBOOL;
  end;
  PCopyEx = ^TCopyEx;

const
  CFEX_CANCEL = WM_USER + 1;

function CopyFileProgress(TotalFileSize, TotalBytesTransferred, StreamSize,
   StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber, dwCallbackReason: DWORD;
   hSourceFile, hDestinationFile: THandle; lpData: Pointer): DWORD; stdcall;
begin
  // no need to watch CancelCopy here...
  // do normal status handling here as needed...
  // use PCopyEx(lpData)^ as needed...
end;

function CopyExThread(p: PCopyEx): Integer;
begin
  try
    if not CopyFileEx(PChar(p.Source), PChar(p.Dest), @CopyFileProgress, p, p.PCancelCopy, COPY_FILE_NO_BUFFERING) then
    begin
      if GetLastError() = ERROR_REQUEST_ABORTED then
        SendMessage(p.Handle, CFEX_CANCEL, 0, 0);
    end;
  finally
    Dispose(p);
  end;
  Result := 0;
end;

procedure TFormMain.ButtonCopyClick(Sender: TObject);
var
  Params: PCopyEx;
  ThreadID: Cardinal;
begin
  New(Params);
  Params.Source := EditOriginal.Text;
  Params.Dest := EditCopied.Text;
  Params.Handle := Handle;
  Params.PCancelCopy := @CancelCopy; // <-- pass address of CancelCopy here...

  CancelCopy := FALSE;
  CloseHandle(BeginThread(nil, 0, @CopyExThread, Params, 0, ThreadID));
end;

procedure TFormMain.ButtonCancelClick(Sender: TObject);
begin
  CancelCopy := TRUE;
end;

话虽如此，还有一些需要注意的地方 - 您正在将 HWND 从 TForm.Handle 属性传递到线程。如果 TForm 曾经 destroys/recreates 它的 HWND 出于任何原因（是的，它可能发生）而线程仍然是运行，则 TCopyEx.Handle 值将是left 指向无效的 window（或者更糟，指向重用旧 HWND 值的新 window）。

通常，TWinControl.Handle 属性不是线程安全的，因此仅出于这个原因，传递 HWND 不是一个好主意31=] 对象到工作线程，除非你可以保证当线程运行时 HWND 不会被销毁（在这个例子中，就是不保证）。

在这个例子中，我会使用一个不同的 HWND，它保证在线程的生命周期内保持不变，例如 TApplication.Handle window（消息发送到这个window 可以通过 TApplication.HookMainWindow()), or the result of calling AllocateHWnd().

处理

例如：

type
  TFormMain = class(TForm)
    procedure FormDestroy(Sender: TObject);
    ...
  private
    CancelCopy: BOOL; // <-- BOOL, not Boolean
    CopyFileExWnd: HWND;
    procedure CopyFileExWndProc(var Message: TMessage);
    ...
  end;

...

type
  TCopyEx = record
    Source: String;
    Dest: String;
    Handle: HWND;
    PCancelCopy: PBOOL;
  end;
  PCopyEx = ^TCopyEx;

const
  CFEX_CANCEL = WM_USER + 1;

function CopyFileProgress(TotalFileSize, TotalBytesTransferred, StreamSize,
   StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber, dwCallbackReason: DWORD;
   hSourceFile, hDestinationFile: THandle; lpData: Pointer): DWORD; stdcall;
begin
  ...
end;

function CopyExThread(p: PCopyEx): Integer;
begin
  try
    if not CopyFileEx(
      PChar(p.Source), PChar(p.Dest), @CopyFileProgress, p, p.PCancelCopy, COPY_FILE_NO_BUFFERING) then
    begin
      if GetLastError() = ERROR_REQUEST_ABORTED then
        SendMessage(p.Handle, CFEX_CANCEL, 0, 0);
    end;
  finally
    Dispose(p);
  end;
  Result := 0;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  if CopyFileExWnd <> 0 then
    DeallocateHWnd(CopyFileExWnd);
end;

procedure TFormMain.ButtonCopyClick(Sender: TObject);
var
  Params: PCopyEx;
  ThreadID: Cardinal;
begin
  if CopyFileExWnd = 0 then
    CopyFileExWnd := AllocateHWnd(CopyFileExWndProc);

  New(Params);
  Params.Source := EditOriginal.Text;
  Params.Dest := EditCopied.Text;
  Params.Handle := CopyFileExWnd;
  Params.PCancelCopy := @CancelCopy;

  CancelCopy := FALSE;
  CloseHandle(BeginThread(nil, 0, @CopyExThread, Params, 0, ThreadID));
end;

procedure TFormMain.ButtonCancelClick(Sender: TObject);
begin
  CancelCopy := TRUE;
end;

procedure TFormMain.CopyFileExWndProc(var Message: TMessage);
begin
  case Message.Msg of
    CFEX_CANCEL: begin
      ...
    end;
    ...
  else
    Message.Result := DefWindowProc(CopyFileExWnd, Message.Msg, Message.WParam, Message.LParam);
  end;
end;

如何安全地从另一个线程检查主线程标志？

How can I safely check a main thread flag from another thread?

delphi

multithreading

delphi-2009