如何发送和处理TService父线程和子线程之间的消息？

我正在使用Delphi 2010创建一个Windows服务，该服务将监视多个注册表项，并在发生更改时执行操作。我使用delphi.about.com的RegMonitorThread，我的问题是我的主要服务线程从未收到TRegMonitorThread发送的消息。如何发送和处理TService父线程和子线程之间的消息？

type 
    TMyService = class(TService) 
    procedure ServiceExecute(Sender: TService); 
    procedure ServiceShutdown(Sender: TService); 
    procedure ServiceStart(Sender: TService; var Started: Boolean); 
    private 
    function main: boolean; 
    { Private declarations } 
    public 
    function GetServiceController: TServiceController; override; 
    procedure WMREGCHANGE(var Msg: TMessage); message WM_REGCHANGE; 
    { Public declarations } 
    end;

procedure TMyService.ServiceStart(Sender: TService; var Started: Boolean); 
begin 
    with TRegMonitorThread.Create do 
    begin 
     FreeOnTerminate := True; 
     Wnd := ServiceThread.Handle; 
     Key := 'SYSTEM\CurrentControlSet\Services\Tcpip\Parameters'; 
     RootKey := HKEY_LOCAL_MACHINE; 
     WatchSub := True; 
     Start; 
    end; 
end;

这里就是我试图处理从注册表通知线程发送的消息...但是这似乎永远不会被调用。

procedure TMyService.WMREGCHANGE(var Msg: TMessage); 
begin 
    OutputDebugString(PChar('Registry change at ' + DateTimeToStr(Now))); 
end;

我已经证实，正在发送的消息，是达到这一点的代码在RegMonitorThread.pas单元

procedure TRegMonitorThread.Execute; 
begin 
    InitThread; 

    while not Terminated do 
    begin 
    if WaitForSingleObject(FEvent, INFINITE) = WAIT_OBJECT_0 then 
    begin 
     fChangeData.RootKey := RootKey; 
     fChangeData.Key := Key; 

     SendMessage(Wnd, WM_REGCHANGE, RootKey, longint(PChar(Key))); 
     ResetEvent(FEvent); 

     RegNotifyChangeKeyValue(FReg.CurrentKey, 1, Filter, FEvent, 1); 
    end; 
    end; 
end;

任何想法对我缺少的是什么吗？我会提到它，因为它可能与问题有关，我在Windows 7上。

来源

2010-11-01 Mick

TServiceThread.Handle是一个线程句柄，而不是一个窗口句柄。你不能用它来接收窗口消息（它可用于线程管理功能），你必须设置一个窗口句柄。你可以在这里找到一个例子：http://delphi.about.com/od/windowsshellapi/l/aa093003a.htm

来源

2010-11-02 09:58:19

线程处理可以接收消息（ TServiceThread确实有自己的消息循环）。您只需使用PostThreadMessage（）而不是SendMessage（）。 – 2010-11-02 18:43:09

Remy使它成为答案，因为我认为这是迄今为止最好的:) – Runner 2010-11-02 20:10:32

AFAIK消息循环已设置，因为TService使用它来将服务控制调用传递给服务线程 - 不知道它是否可以用于处理不同的消息容易。 – 2010-11-03 09:41:34

嗯我不知道ServiceThread.Handle以及它如何在Windows 7上的行为，但更安全的方式可能是只需通过“AllocateHwnd”创建一个新的窗口句柄。然后只需使用WndProc即可。像这样（的方式做你检查的句柄窗口是一个有效的价值？）：

FWinHandle := AllocateHWND(WndProc);

释放它这样

procedure TMyService.DeallocateHWnd(Wnd: HWND); 
var 
    Instance: Pointer; 
begin 
    Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); 

    if Instance <> @DefWindowProc then 
    begin 
    { make sure we restore the default 
     windows procedure before freeing memory } 
    SetWindowLong(Wnd, GWL_WNDPROC, Longint(@DefWindowProc)); 
    FreeObjectInstance(Instance); 
    end; 

    DestroyWindow(Wnd); 
end;

的WndProc的过程

procedure TMyService.WndProc(var msg: TMessage); 
begin 
    if Msg.Msg = WM_REGCHANGE then 
    begin 
    { 
    if the message id is WM_ON_SCHEDULE 
    do our own processing 
    } 
    end 
    else 
    { 
    for all other messages call 
    the default window procedure 
    } 
    Msg.Result := DefWindowProc(FWinHandle, Msg.Msg, Msg.wParam, Msg.lParam); 
end;

这适用于Windows 7的线程和服务。我在几个地方使用它。它认为使用一些内部的VCL服务窗口更安全。

来源

2010-11-01 21:55:27 Runner

我经常遇到同样的问题。我看了一下OmniThreadLibrary，它看起来像是为了我的目的而矫枉过正。我写了一个简单的库，我称之为TCommThread。它允许您将数据传回主线程，而不用担心线程或Windows消息的复杂性。

如果您想尝试下面的代码，

CommThread库：

unit Threading.CommThread; 

interface 

uses 
    Classes, SysUtils, ExtCtrls, SyncObjs, Generics.Collections, DateUtils; 

const 
    CTID_USER = 1000; 
    PRM_USER = 1000; 

    CTID_STATUS = 1; 
    CTID_PROGRESS = 2; 

type 
    TThreadParams = class(TDictionary<String, Variant>); 
    TThreadObjects = class(TDictionary<String, TObject>); 

    TCommThreadParams = class(TObject) 
    private 
    FThreadParams: TThreadParams; 
    FThreadObjects: TThreadObjects; 
    public 
    constructor Create; 
    destructor Destroy; override; 

    procedure Clear; 

    function GetParam(const ParamName: String): Variant; 
    function SetParam(const ParamName: String; ParamValue: Variant): TCommThreadParams; 
    function GetObject(const ObjectName: String): TObject; 
    function SetObject(const ObjectName: String; Obj: TObject): TCommThreadParams; 
    end; 

    TCommQueueItem = class(TObject) 
    private 
    FSender: TObject; 
    FMessageId: Integer; 
    FCommThreadParams: TCommThreadParams; 
    public 
    destructor Destroy; override; 

    property Sender: TObject read FSender write FSender; 
    property MessageId: Integer read FMessageId write FMessageId; 
    property CommThreadParams: TCommThreadParams read FCommThreadParams write FCommThreadParams; 
    end; 

    TCommQueue = class(TQueue<TCommQueueItem>); 

    ICommDispatchReceiver = interface 
    ['{A4E2C9D1-E4E8-497D-A9BF-FAFE2D3A7C49}'] 
    procedure QueueMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); 
    procedure CommThreadTerminated(Sender: TObject); 
    function Cancelled: Boolean; 
    end; 

    TCommThread = class(TThread) 
    protected 
    FCommThreadParams: TCommThreadParams; 
    FCommDispatchReceiver: ICommDispatchReceiver; 
    FName: String; 
    FProgressFrequency: Integer; 
    FNextSendTime: TDateTime; 

    procedure SendStatusMessage(const StatusText: String; StatusType: Integer = 0); virtual; 
    procedure SendProgressMessage(ProgressID: Int64; Progress, ProgressMax: Integer; AlwaysSend: Boolean = TRUE); virtual; 
    public 
    constructor Create(CommDispatchReceiver: TObject); reintroduce; virtual; 
    destructor Destroy; override; 

    function SetParam(const ParamName: String; ParamValue: Variant): TCommThread; 
    function GetParam(const ParamName: String): Variant; 
    function SetObject(const ObjectName: String; Obj: TObject): TCommThread; 
    function GetObject(const ObjectName: String): TObject; 
    procedure SendCommMessage(MessageId: Integer; CommThreadParams: TCommThreadParams); virtual; 

    property Name: String read FName; 
    end; 

    TCommThreadClass = Class of TCommThread; 

    TCommThreadQueue = class(TObjectList<TCommThread>); 

    TCommThreadDispatchState = (
    ctsIdle, 
    ctsActive, 
    ctsTerminating 
); 

    TOnReceiveThreadMessage = procedure(Source, Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams) of object; 
    TOnStateChange = procedure(Sender: TObject; State: TCommThreadDispatchState) of object; 
    TOnStatus = procedure(Source, Sender: TObject; const ID: String; StatusText: String; StatusType: Integer) of object; 
    TOnProgress = procedure(Source, Sender: TObject; const ID: String; Progress, ProgressMax: Integer) of object; 

    TBaseCommThreadDispatch = class(TComponent, ICommDispatchReceiver) 
    private 
    FProcessQueueTimer: TTimer; 
    FCSReceiveMessage: TCriticalSection; 
    FCSCommThreads: TCriticalSection; 
    FCommQueue: TCommQueue; 
    FActiveThreads: TList; 
    FCommThreadClass: TCommThreadClass; 
    FCommThreadDispatchState: TCommThreadDispatchState; 

    function CreateThread(const ThreadName: String = ''): TCommThread; 
    function GetActiveThreadCount: Integer; 
    function GetStateText: String; 
    protected 
    FOnReceiveThreadMessage: TOnReceiveThreadMessage; 
    FOnStateChange: TOnStateChange; 
    FOnStatus: TOnStatus; 
    FOnProgress: TOnProgress; 
    FManualMessageQueue: Boolean; 
    FProgressFrequency: Integer; 

    procedure SetManualMessageQueue(const Value: Boolean); 
    procedure SetProcessQueueTimerInterval(const Value: Integer); 
    procedure SetCommThreadDispatchState(const Value: TCommThreadDispatchState); 
    procedure QueueMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); 
    procedure OnProcessQueueTimer(Sender: TObject); 
    function GetProcessQueueTimerInterval: Integer; 

    procedure CommThreadTerminated(Sender: TObject); virtual; 
    function Finished: Boolean; virtual; 

    procedure DoOnReceiveThreadMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); virtual; 
    procedure DoOnStateChange; virtual; 

    procedure TerminateActiveThreads; 

    property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage; 
    property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange; 
    property OnStatus: TOnStatus read FOnStatus write FOnStatus; 
    property OnProgress: TOnProgress read FOnProgress write FOnProgress; 

    property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency; 
    property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval; 
    property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue; 
    property CommThreadDispatchState: TCommThreadDispatchState read FCommThreadDispatchState write SetCommThreadDispatchState; 
    public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 

    function NewThread(const ThreadName: String = ''): TCommThread; virtual; 
    procedure ProcessMessageQueue; virtual; 
    procedure Stop; virtual; 
    function State: TCommThreadDispatchState; 
    function Cancelled: Boolean; 

    property ActiveThreadCount: Integer read GetActiveThreadCount; 
    property StateText: String read GetStateText; 

    property CommThreadClass: TCommThreadClass read FCommThreadClass write FCommThreadClass; 
    end; 

    TCommThreadDispatch = class(TBaseCommThreadDispatch) 
    published 
    property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage; 
    property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange; 

    property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency; 
    property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval; 
    property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue; 
    end; 

    TBaseStatusCommThreadDispatch = class(TBaseCommThreadDispatch) 
    protected 
    FOnStatus: TOnStatus; 
    FOnProgress: TOnProgress; 

    procedure DoOnReceiveThreadMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); override; 

    procedure DoOnStatus(Sender: TObject;const ID: String; const StatusText: String; StatusType: Integer); virtual; 
    procedure DoOnProgress(Sender: TObject; const ID: String; Progress, ProgressMax: Integer); virtual; 

    property OnStatus: TOnStatus read FOnStatus write FOnStatus; 
    property OnProgress: TOnProgress read FOnProgress write FOnProgress; 
    end; 

    TStatusCommThreadDispatch = class(TBaseStatusCommThreadDispatch) 
    published 
    property OnReceiveThreadMessage: TOnReceiveThreadMessage read FOnReceiveThreadMessage write FOnReceiveThreadMessage; 
    property OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange; 
    property OnStatus: TOnStatus read FOnStatus write FOnStatus; 
    property OnProgress: TOnProgress read FOnProgress write FOnProgress; 

    property ProgressFrequency: Integer read FProgressFrequency write FProgressFrequency; 
    property ProcessQueueTimerInterval: Integer read GetProcessQueueTimerInterval write SetProcessQueueTimerInterval; 
    property ManualMessageQueue: Boolean read FManualMessageQueue write SetManualMessageQueue; 
    end; 

implementation 

const 
    PRM_STATUS_TEXT = 'Status'; 
    PRM_STATUS_TYPE = 'Type'; 
    PRM_PROGRESS_ID = 'ProgressID'; 
    PRM_PROGRESS = 'Progess'; 
    PRM_PROGRESS_MAX = 'ProgressMax'; 

resourcestring 
    StrCommReceiverMustSupportInterface = 'CommDispatchReceiver must support ICommDispatchReceiver interface'; 
    StrSenderMustBeATCommThread = 'Sender must be a TCommThread'; 
    StrUnableToFindTerminatedThread = 'Unable to find the terminated thread'; 
    StrIdle = 'Idle'; 
    StrTerminating = 'Terminating'; 
    StrActive = 'Active'; 

{ TCommThread } 

constructor TCommThread.Create(CommDispatchReceiver: TObject); 
begin 
    Assert(Supports(CommDispatchReceiver, ICommDispatchReceiver, FCommDispatchReceiver), StrCommReceiverMustSupportInterface); 

    inherited Create(TRUE); 

    FCommThreadParams := TCommThreadParams.Create; 
end; 

destructor TCommThread.Destroy; 
begin 
    FCommDispatchReceiver.CommThreadTerminated(Self); 

    FreeAndNil(FCommThreadParams); 

    inherited; 
end; 

function TCommThread.GetObject(const ObjectName: String): TObject; 
begin 
    Result := FCommThreadParams.GetObject(ObjectName); 
end; 

function TCommThread.GetParam(const ParamName: String): Variant; 
begin 
    Result := FCommThreadParams.GetParam(ParamName); 
end; 

procedure TCommThread.SendCommMessage(MessageId: Integer; 
    CommThreadParams: TCommThreadParams); 
begin 
    FCommDispatchReceiver.QueueMessage(Self, MessageId, CommThreadParams); 
end; 

procedure TCommThread.SendProgressMessage(ProgressID: Int64; Progress, 
    ProgressMax: Integer; AlwaysSend: Boolean); 
begin 
    if (AlwaysSend) or (now > FNextSendTime) then 
    begin 
    // Send a status message to the comm receiver 
    SendCommMessage(CTID_PROGRESS, TCommThreadParams.Create 
     .SetParam(PRM_PROGRESS_ID, ProgressID) 
     .SetParam(PRM_PROGRESS, Progress) 
     .SetParam(PRM_PROGRESS_MAX, ProgressMax)); 

    if not AlwaysSend then 
     FNextSendTime := now + (FProgressFrequency * OneMillisecond); 
    end; 
end; 

procedure TCommThread.SendStatusMessage(const StatusText: String; 
    StatusType: Integer); 
begin 
    // Send a status message to the comm receiver 
    SendCommMessage(CTID_STATUS, TCommThreadParams.Create 
    .SetParam(PRM_STATUS_TEXT, StatusText) 
    .SetParam(PRM_STATUS_TYPE, StatusType)); 
end; 

function TCommThread.SetObject(const ObjectName: String; 
    Obj: TObject): TCommThread; 
begin 
    Result := Self; 

    FCommThreadParams.SetObject(ObjectName, Obj); 
end; 

function TCommThread.SetParam(const ParamName: String; 
    ParamValue: Variant): TCommThread; 
begin 
    Result := Self; 

    FCommThreadParams.SetParam(ParamName, ParamValue); 
end; 


{ TCommThreadDispatch } 

function TBaseCommThreadDispatch.Cancelled: Boolean; 
begin 
    Result := State = ctsTerminating; 
end; 

procedure TBaseCommThreadDispatch.CommThreadTerminated(Sender: TObject); 
var 
    idx: Integer; 
begin 
    FCSCommThreads.Enter; 
    try 
    Assert(Sender is TCommThread, StrSenderMustBeATCommThread); 

    // Find the thread in the active thread list 
    idx := FActiveThreads.IndexOf(Sender); 

    Assert(idx <> -1, StrUnableToFindTerminatedThread); 

    // if we find it, remove it (we should always find it) 
    FActiveThreads.Delete(idx); 
    finally 
    FCSCommThreads.Leave; 
    end; 
end; 

constructor TBaseCommThreadDispatch.Create(AOwner: TComponent); 
begin 
    inherited; 

    FCommThreadClass := TCommThread; 

    FProcessQueueTimer := TTimer.Create(nil); 
    FProcessQueueTimer.Enabled := FALSE; 
    FProcessQueueTimer.Interval := 5; 
    FProcessQueueTimer.OnTimer := OnProcessQueueTimer; 
    FProgressFrequency := 200; 

    FCommQueue := TCommQueue.Create; 

    FActiveThreads := TList.Create; 

    FCSReceiveMessage := TCriticalSection.Create; 
    FCSCommThreads := TCriticalSection.Create; 
end; 

destructor TBaseCommThreadDispatch.Destroy; 
begin 
    // Stop the queue timer 
    FProcessQueueTimer.Enabled := FALSE; 

    TerminateActiveThreads; 

    // Pump the queue while there are active threads 
    while CommThreadDispatchState <> ctsIdle do 
    begin 
    ProcessMessageQueue; 

    sleep(10); 
    end; 

    // Free everything 
    FreeAndNil(FProcessQueueTimer); 
    FreeAndNil(FCommQueue); 
    FreeAndNil(FCSReceiveMessage); 
    FreeAndNil(FCSCommThreads); 
    FreeAndNil(FActiveThreads); 

    inherited; 
end; 

procedure TBaseCommThreadDispatch.DoOnReceiveThreadMessage(Sender: TObject; 
    MessageId: Integer; CommThreadParams: TCommThreadParams); 
begin 
    // Don't send the messages if we're being destroyed 
    if not (csDestroying in ComponentState) then 
    begin 
    if Assigned(FOnReceiveThreadMessage) then 
     FOnReceiveThreadMessage(Self, Sender, MessageId, CommThreadParams); 
    end; 
end; 

procedure TBaseCommThreadDispatch.DoOnStateChange; 
begin 
    if (Assigned(FOnStateChange)) and (not (csDestroying in ComponentState)) then 
    FOnStateChange(Self, FCommThreadDispatchState); 
end; 

function TBaseCommThreadDispatch.GetActiveThreadCount: Integer; 
begin 
    Result := FActiveThreads.Count; 
end; 

function TBaseCommThreadDispatch.GetProcessQueueTimerInterval: Integer; 
begin 
    Result := FProcessQueueTimer.Interval; 
end; 


function TBaseCommThreadDispatch.GetStateText: String; 
begin 
    case State of 
    ctsIdle: Result := StrIdle; 
    ctsTerminating: Result := StrTerminating; 
    ctsActive: Result := StrActive; 
    end; 
end; 

function TBaseCommThreadDispatch.NewThread(const ThreadName: String): TCommThread; 
begin 
    if FCommThreadDispatchState = ctsTerminating then 
    Result := nil 
    else 
    begin 
    // Make sure we're active 
    if CommThreadDispatchState = ctsIdle then 
     CommThreadDispatchState := ctsActive; 

    Result := CreateThread(ThreadName); 

    FActiveThreads.Add(Result); 

    if ThreadName = '' then 
     Result.FName := IntToStr(Integer(Result)) 
    else 
     Result.FName := ThreadName; 

    Result.FProgressFrequency := FProgressFrequency; 
    end; 
end; 

function TBaseCommThreadDispatch.CreateThread(
    const ThreadName: String): TCommThread; 
begin 
    Result := FCommThreadClass.Create(Self); 

    Result.FreeOnTerminate := TRUE; 
end; 

procedure TBaseCommThreadDispatch.OnProcessQueueTimer(Sender: TObject); 
begin 
    ProcessMessageQueue; 
end; 

procedure TBaseCommThreadDispatch.ProcessMessageQueue; 
var 
    CommQueueItem: TCommQueueItem; 
begin 
    if FCommThreadDispatchState in [ctsActive, ctsTerminating] then 
    begin 
    if FCommQueue.Count > 0 then 
    begin 
     FCSReceiveMessage.Enter; 
     try 
     CommQueueItem := FCommQueue.Dequeue; 

     while Assigned(CommQueueItem) do 
     begin 
      try 
      DoOnReceiveThreadMessage(CommQueueItem.Sender, CommQueueItem.MessageId, CommQueueItem.CommThreadParams); 
      finally 
      FreeAndNil(CommQueueItem); 
      end; 

      if FCommQueue.Count > 0 then 
      CommQueueItem := FCommQueue.Dequeue; 
     end; 
     finally 
     FCSReceiveMessage.Leave 
     end; 
    end; 

    if Finished then 
    begin 
     FCommThreadDispatchState := ctsIdle; 

     DoOnStateChange; 
    end; 
    end; 
end; 

function TBaseCommThreadDispatch.Finished: Boolean; 
begin 
    Result := FActiveThreads.Count = 0; 
end; 

procedure TBaseCommThreadDispatch.QueueMessage(Sender: TObject; MessageId: Integer; 
    CommThreadParams: TCommThreadParams); 
var 
    CommQueueItem: TCommQueueItem; 
begin 
    FCSReceiveMessage.Enter; 
    try 
    CommQueueItem := TCommQueueItem.Create; 
    CommQueueItem.Sender := Sender; 
    CommQueueItem.MessageId := MessageId; 
    CommQueueItem.CommThreadParams := CommThreadParams; 

    FCommQueue.Enqueue(CommQueueItem); 
    finally 
    FCSReceiveMessage.Leave 
    end; 
end; 

procedure TBaseCommThreadDispatch.SetCommThreadDispatchState(
    const Value: TCommThreadDispatchState); 
begin 
    if FCommThreadDispatchState <> ctsTerminating then 
    begin 
    if Value = ctsActive then 
    begin 
     if not FManualMessageQueue then 
     FProcessQueueTimer.Enabled := TRUE; 
    end 
    else 
     TerminateActiveThreads; 
    end; 

    FCommThreadDispatchState := Value; 

    DoOnStateChange; 
end; 

procedure TBaseCommThreadDispatch.SetManualMessageQueue(const Value: Boolean); 
begin 
    FManualMessageQueue := Value; 
end; 

procedure TBaseCommThreadDispatch.SetProcessQueueTimerInterval(const Value: Integer); 
begin 
    FProcessQueueTimer.Interval := Value; 
end; 

function TBaseCommThreadDispatch.State: TCommThreadDispatchState; 
begin 
    Result := FCommThreadDispatchState; 
end; 

procedure TBaseCommThreadDispatch.Stop; 
begin 
    if CommThreadDispatchState = ctsActive then 
    TerminateActiveThreads; 
end; 

procedure TBaseCommThreadDispatch.TerminateActiveThreads; 
var 
    i: Integer; 
begin 
    if FCommThreadDispatchState = ctsActive then 
    begin 
    // Lock threads 
    FCSCommThreads.Acquire; 
    try 
     FCommThreadDispatchState := ctsTerminating; 

     DoOnStateChange; 

     // Terminate each thread in turn 
     for i := 0 to pred(FActiveThreads.Count) do 
     TCommThread(FActiveThreads[i]).Terminate; 
    finally 
     FCSCommThreads.Release; 
    end; 
    end; 
end; 


{ TCommThreadParams } 

procedure TCommThreadParams.Clear; 
begin 
    FThreadParams.Clear; 
    FThreadObjects.Clear; 
end; 

constructor TCommThreadParams.Create; 
begin 
    FThreadParams := TThreadParams.Create; 
    FThreadObjects := TThreadObjects.Create; 
end; 

destructor TCommThreadParams.Destroy; 
begin 
    FreeAndNil(FThreadParams); 
    FreeAndNil(FThreadObjects); 

    inherited; 
end; 

function TCommThreadParams.GetObject(const ObjectName: String): TObject; 
begin 
    Result := FThreadObjects.Items[ObjectName]; 
end; 

function TCommThreadParams.GetParam(const ParamName: String): Variant; 
begin 
    Result := FThreadParams.Items[ParamName]; 
end; 

function TCommThreadParams.SetObject(const ObjectName: String; 
    Obj: TObject): TCommThreadParams; 
begin 
    FThreadObjects.AddOrSetValue(ObjectName, Obj); 

    Result := Self; 
end; 

function TCommThreadParams.SetParam(const ParamName: String; 
    ParamValue: Variant): TCommThreadParams; 
begin 
    FThreadParams.AddOrSetValue(ParamName, ParamValue); 

    Result := Self; 
end; 

{ TCommQueueItem } 

destructor TCommQueueItem.Destroy; 
begin 
    if Assigned(FCommThreadParams) then 
    FreeAndNil(FCommThreadParams); 

    inherited; 
end; 


{ TBaseStatusCommThreadDispatch } 

procedure TBaseStatusCommThreadDispatch.DoOnReceiveThreadMessage(
    Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); 
begin 
    inherited; 

    case MessageId of 
    // Status Message 
    CTID_STATUS: DoOnStatus(Sender, 
          Name, 
          CommThreadParams.GetParam(PRM_STATUS_TEXT), 
          CommThreadParams.GetParam(PRM_STATUS_TYPE)); 
    // Progress Message 
    CTID_PROGRESS: DoOnProgress(Sender, 
           CommThreadParams.GetParam(PRM_PROGRESS_ID), 
           CommThreadParams.GetParam(PRM_PROGRESS), 
           CommThreadParams.GetParam(PRM_PROGRESS_MAX)); 
    end; 
end; 

procedure TBaseStatusCommThreadDispatch.DoOnStatus(Sender: TObject; const ID, 
    StatusText: String; StatusType: Integer); 
begin 
    if (not (csDestroying in ComponentState)) and (Assigned(FOnStatus)) then 
    FOnStatus(Self, Sender, ID, StatusText, StatusType); 
end; 

procedure TBaseStatusCommThreadDispatch.DoOnProgress(Sender: TObject; 
    const ID: String; Progress, ProgressMax: Integer); 
begin 
    if not (csDestroying in ComponentState) and (Assigned(FOnProgress)) then 
    FOnProgress(Self, Sender, ID, Progress, ProgressMax); 
end; 

end.

要使用库，只是下降的线程从TCommThread线和覆盖执行程序：

MyCommThreadObject = class(TCommThread) 
public 
    procedure Execute; override; 
end;

接下来，创建TStatusCommThreadDispatch组件的后裔和设置它的事件。

MyCommThreadComponent := TStatusCommThreadDispatch.Create(Self); 

    // Add the event handlers 
    MyCommThreadComponent.OnStateChange := OnStateChange; 
    MyCommThreadComponent.OnReceiveThreadMessage := OnReceiveThreadMessage; 
    MyCommThreadComponent.OnStatus := OnStatus; 
    MyCommThreadComponent.OnProgress := OnProgress; 

    // Set the thread class 
    MyCommThreadComponent.CommThreadClass := TMyCommThread;

确保将CommThreadClass设置为您的TCommThread后代。

现在，所有你需要做的是通过MyCommThreadComponent创建线程：

FCommThreadComponent.NewThread 
    .SetParam('MyThreadInputParameter', '12345') 
    .SetObject('MyThreadInputObject', MyObject) 
    .Start;

添加尽可能多的参数和对象，只要你喜欢。在你的线程Execute方法中，你可以检索参数和对象。

MyThreadParameter := GetParam('MyThreadInputParameter'); // 12345 
MyThreadObject := GetObject('MyThreadInputObject'); // MyObject

参数将被自动释放。你需要自己管理对象。

要将信息发送回从线程的主线程执行方法：

FCommDispatchReceiver.QueueMessage(Self, CTID_MY_MESSAGE_ID, TCommThreadParams.Create 
    .SetObject('MyThreadObject', MyThreadObject) 
    .SetParam('MyThreadOutputParameter', MyThreadParameter));

再次，参数将自动销毁，对象必须自己管理。

要接收的消息在主线程或者附加OnReceiveThreadMessage事件或重写DoOnReceiveThreadMessage过程：

procedure DoOnReceiveThreadMessage(Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); override;

使用覆盖的过程来处理发回给你的主线程中的消息：

procedure THostDiscovery.DoOnReceiveThreadMessage(Sender: TObject; 
    MessageId: Integer; CommThreadParams: TCommThreadParams); 
begin 
    inherited; 

    case MessageId of 

    CTID_MY_MESSAGE_ID: 
     begin 
     // Process the CTID_MY_MESSAGE_ID message 
     DoSomethingWithTheMessage(CommThreadParams.GetParam('MyThreadOutputParameter'), 
            CommThreadParams.GeObject('MyThreadObject')); 
     end; 
    end; 
end;

消息在ProcessMessageQueue过程中被泵送。该过程通过TTimer调用。如果您在控制台应用程序中使用该组件，则需要手动拨打ProcessMessageQueue。计时器将在第一个线程创建时启动。当最后一个线程结束时它会停止。如果您需要控制计时器何时停止，则可以覆盖完成过程。您也可以通过重写DoOnStateChange过程来根据线程状态执行操作。

看看TCommThread后裔TStatusCommThreadDispatch。它实现简单的Status和Progress消息发送回主线程。

我希望这可以帮助，我已经解释了它。

来源

2010-11-03 09:41:28 norgepaul

这与我以前的答案有关，但我被限制为30000个字符。

下面是一个使用TCommThread一个测试应用程序的代码：

测试应用程序（.PAS）

unit frmMainU; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, ComCtrls, ExtCtrls, StdCtrls, 

    Threading.CommThread; 

type 
    TMyCommThread = class(TCommThread) 
    public 
    procedure Execute; override; 
    end; 

    TfrmMain = class(TForm) 
    Panel1: TPanel; 
    lvLog: TListView; 
    btnStop: TButton; 
    btnNewThread: TButton; 
    StatusBar1: TStatusBar; 
    btn30NewThreads: TButton; 
    tmrUpdateStatusBar: TTimer; 
    procedure FormCreate(Sender: TObject); 
    procedure btnStopClick(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
    procedure Button4Click(Sender: TObject); 
    procedure tmrUpdateStatusBarTimer(Sender: TObject); 
    private 
    FCommThreadComponent: TStatusCommThreadDispatch; 

    procedure OnReceiveThreadMessage(Source, Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); 
    procedure OnStateChange(Sender: TObject; State: TCommThreadDispatchState); 
    procedure UpdateStatusBar; 
    procedure OnStatus(Source, Sender: TObject; const ID: String; StatusText: String; StatusType: Integer); 
    procedure OnProgress(Source, Sender: TObject; const ID: String; Progress, ProgressMax: Integer); 
    public 

    end; 

var 
    frmMain: TfrmMain; 

implementation 

resourcestring 
    StrStatusIDDProgre = 'StatusID: %s, Progress: %d, ProgressMax: %d'; 
    StrActiveThreadsD = 'Active Threads: %d, State: %s'; 
    StrIdle = 'Idle'; 
    StrActive = 'Active'; 
    StrTerminating = 'Terminating'; 

{$R *.dfm} 

{ TMyCommThread } 

procedure TMyCommThread.Execute; 
var 
    i: Integer; 
begin 
    SendCommMessage(0, TCommThreadParams.Create.SetParam('status', 'started')); 

    for i := 0 to 40 do 
    begin 
    sleep(50); 

    SendStatusMessage(format('Thread: %s, i = %d', [Name, i]), 1); 

    if Terminated then 
     Break; 

    sleep(50); 

    SendProgressMessage(Integer(Self), i, 40, FALSE); 
    end; 

    if Terminated then 
    SendCommMessage(0, TCommThreadParams.Create.SetParam('status', 'terminated')) 
    else 
    SendCommMessage(0, TCommThreadParams.Create.SetParam('status', 'finished')); 
end; 


{ TfrmMain } 

procedure TfrmMain.btnStopClick(Sender: TObject); 
begin 
    FCommThreadComponent.Stop; 
end; 

procedure TfrmMain.Button3Click(Sender: TObject); 
var 
    i: Integer; 
begin 
    for i := 0 to 29 do 
    FCommThreadComponent.NewThread 
     .SetParam('input_param1', 'test_value') 
     .Start; 
end; 

procedure TfrmMain.Button4Click(Sender: TObject); 
begin 
    FCommThreadComponent.NewThread 
    .SetParam('input_param1', 'test_value') 
    .Start; 
end; 

procedure TfrmMain.FormCreate(Sender: TObject); 
begin 
    FCommThreadComponent := TStatusCommThreadDispatch.Create(Self); 

    // Add the event handlers 
    FCommThreadComponent.OnStateChange := OnStateChange; 
    FCommThreadComponent.OnReceiveThreadMessage := OnReceiveThreadMessage; 
    FCommThreadComponent.OnStatus := OnStatus; 
    FCommThreadComponent.OnProgress := OnProgress; 

    // Set the thread class 
    FCommThreadComponent.CommThreadClass := TMyCommThread; 
end; 

procedure TfrmMain.OnProgress(Source, Sender: TObject; const ID: String; Progress, ProgressMax: Integer); 
begin 
    With lvLog.Items.Add do 
    begin 
    Caption := '-'; 

    SubItems.Add(format(StrStatusIDDProgre, [Id, Progress, ProgressMax])); 
    end; 
end; 

procedure TfrmMain.OnReceiveThreadMessage(Source, Sender: TObject; MessageId: Integer; CommThreadParams: TCommThreadParams); 
begin 
    if MessageID = 0 then 
    With lvLog.Items.Add do 
    begin 
     Caption := IntToStr(MessageId); 

     SubItems.Add(CommThreadParams.GetParam('status')); 
    end; 
end; 

procedure TfrmMain.UpdateStatusBar; 
begin 
    StatusBar1.SimpleText := format(StrActiveThreadsD, [FCommThreadComponent.ActiveThreadCount, FCommThreadComponent.StateText]); 
end; 

procedure TfrmMain.OnStateChange(Sender: TObject; State: TCommThreadDispatchState); 
begin 
    With lvLog.Items.Add do 
    begin 
    case State of 
     ctsIdle: Caption := StrIdle; 
     ctsActive: Caption := StrActive; 
     ctsTerminating: Caption := StrTerminating; 
    end; 
    end; 
end; 

procedure TfrmMain.OnStatus(Source, Sender: TObject; const ID: String; StatusText: String; StatusType: Integer); 
begin 
    With lvLog.Items.Add do 
    begin 
    Caption := IntToStr(StatusType); 

    SubItems.Add(StatusText); 
    end; 
end; 

procedure TfrmMain.tmrUpdateStatusBarTimer(Sender: TObject); 
begin 
    UpdateStatusBar; 
end; 

end.

测试应用（.DFM）

object frmMain: TfrmMain 
    Left = 0 
    Top = 0 
    Caption = 'CommThread Test' 
    ClientHeight = 290 
    ClientWidth = 557 
    Color = clBtnFace 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'Tahoma' 
    Font.Style = [] 
    OldCreateOrder = False 
    OnCreate = FormCreate 
    PixelsPerInch = 96 
    TextHeight = 13 
    object Panel1: TPanel 
    AlignWithMargins = True 
    Left = 3 
    Top = 3 
    Width = 97 
    Height = 265 
    Margins.Right = 0 
    Align = alLeft 
    BevelOuter = bvNone 
    TabOrder = 0 
    object btnStop: TButton 
     AlignWithMargins = True 
     Left = 0 
     Top = 60 
     Width = 97 
     Height = 25 
     Margins.Left = 0 
     Margins.Top = 10 
     Margins.Right = 0 
     Margins.Bottom = 0 
     Align = alTop 
     Caption = 'Stop' 
     TabOrder = 2 
     OnClick = btnStopClick 
    end 
    object btnNewThread: TButton 
     Left = 0 
     Top = 0 
     Width = 97 
     Height = 25 
     Align = alTop 
     Caption = 'New Thread' 
     TabOrder = 0 
     OnClick = Button4Click 
    end 
    object btn30NewThreads: TButton 
     Left = 0 
     Top = 25 
     Width = 97 
     Height = 25 
     Align = alTop 
     Caption = '30 New Threads' 
     TabOrder = 1 
     OnClick = Button3Click 
    end 
    end 
    object lvLog: TListView 
    AlignWithMargins = True 
    Left = 103 
    Top = 3 
    Width = 451 
    Height = 265 
    Align = alClient 
    Columns = < 
     item 
     Caption = 'Message ID' 
     Width = 70 
     end 
     item 
     AutoSize = True 
     Caption = 'Info' 
     end> 
    ReadOnly = True 
    RowSelect = True 
    TabOrder = 1 
    ViewStyle = vsReport 
    end 
    object StatusBar1: TStatusBar 
    Left = 0 
    Top = 271 
    Width = 557 
    Height = 19 
    Panels = <> 
    SimplePanel = True 
    end 
    object tmrUpdateStatusBar: TTimer 
    Interval = 200 
    OnTimer = tmrUpdateStatusBarTimer 
    Left = 272 
    Top = 152 
    end 
end

来源

2010-11-03 09:43:54 norgepaul

如何发送和处理TService父线程和子线程之间的消息？

回答

相关问题