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

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()将为您监控该变量，当变量设置时，您不需要手动返回PROGRESS_CANCEL回调函数（如果回调函数遇到与复制本身无关的错误，则返回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; 

虽这么说，别的东西需要注意的 - 你是从TForm.Handle属性传递HWND到线程。如果TForm在线程仍在运行时出于任何原因破坏/重新创建其HWND，则TCopyEx.Handle值将指向无效窗口（或更糟糕的是，指向重新使用旧窗口的新窗口HWND值）。

一般来说，TWinControl.Handle属性不是线程安全的，所以单是这一理由，它不是一个TWinControl对象的HWND传递给工作线程是一个好主意，除非你能保证的HWND在线程运行时不会被销毁（在这个例子中，这是不能保证的）。

在本例中，我会用这是保证一个不同HWND成为螺纹的寿命，如TApplication.Handle窗口（发送到这个窗口的消息可以经由TApplication.HookMainWindow()处理），或调用的结果持久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;