一种线程消息驱动及RTTI分发操作-优快云博客

最近一个手头的一个软件升级，原来的线程设计由于经验不足，导致了诸如无法重连、数据传递实现复杂等问题，近段时间的开发积累的一些经验，和大家一并分享。

为什么要线程消息驱动？
1)Thread插入主线程运行最致命的问题是必须调用一个无参数procedure，这对操作带来了很大的麻烦，通常执行一个操作很容易的想到带会一些信息返回。例如网络请求的返回。
2)更符合编程习惯，由于Thread的Synchronize是插入主线程运行。导致主线程的一部分代码必须public开放给外部来调用，而分发消息的机制更适合屏蔽外部接口（只依赖一个统一的消息分发入口，非直接调用对应的操作）。
3)消息驱动能够实现简单的操作队列
由于WINDOWS消息为队列形式，因此能够实现单线程的任务排队。典型的如记录日志的操作，向日志线程发送消息来依次处理，避免了并发写文件的问题和线程同步的问题，提交了写入效率，让编程更加简单

接下来要介绍几个关键信息（如需要更详细资料直接GOOGLE搜索，容易找到）：
RTTI及{$M+}{$M-}: M开关打开published property的RTTI开关，实现类似反射的调用来请求类方法，避免分支过多的IF...ELSE
PostThreadMessage: WINDOWS API线程消息通讯方法，提供主线程与子线程，子线程之间的通讯，导入单元windows
AllocMem, FreeMemory: 为字符串消息分配内存，释放存储
GetPropInfo: 获得类published property的RTTI信息
SetOrdProp: RTTI方式调用published property的write方法写入WORD值

接下来是线程基类的实现：
unit UnitBaseThread; { 线程处理公共单元 Author: Jim } interface uses Classes, Windows, Messages, SysUtils, Forms, TypInfo; type TBaseThread = class(TThread) private procedure dispatchMessageData(const command:string; data: Integer); protected procedure postMainForm(const command: string; data: Pointer); //子线程发送到主线程通讯 procedure Execute; override; public ss: Pointer; procedure exitThread; //退出子线程 procedure postThreadData(const command:string; data: Pointer); //发送到当前线程，主线程-子线程通讯或子线程-子线程通讯 published end; implementation procedure TBaseThread.Execute; var AMsg: TMsg; pStr: Pointer; S: String; begin while GetMessage(AMsg,0,0,0) do begin if Self.Terminated then Exit; case AMsg.message of WM_CLOSE: //接受CLOSE消息退出 Exit; WM_NULL: //接受NULL消息执行动作 begin pStr := PChar(AMsg.wParam); if Assigned(pStr) then begin try dispatchMessageData(StrPas(pStr), AMsg.lParam); //通过分发数据到子类RTTI方法 except end; FreeMemory(pStr); end; end; end; end; end; procedure TBaseThread.exitThread; begin Terminate; PostThreadMessage(Self.ThreadID, WM_CLOSE, 0, 0); end; procedure TBaseThread.dispatchMessageData(const command:string; data: Integer); var PropInfo: PPropInfo; begin PropInfo := GetPropInfo(Self,command); if PropInfo <> nil then SetOrdProp(Self, PropInfo, data); end; procedure TBaseThread.postMainForm(const command: string; data: Pointer); var pStr: Pointer; begin pStr := AllocMem(Length(command) + 1); StrCopy(pStr, PChar(command)); PostMessage(Application.MainForm.Handle, WM_USER, Integer(pStr), Integer(data)); end; procedure TBaseThread.postThreadData(const command: string; data: Pointer); var pStr: Pointer; begin pStr := AllocMem(Length(command) + 1); StrCopy(pStr, PChar(command)); PostThreadMessage(Self.ThreadID, WM_NULL, Integer(pStr), Integer(data)); end; end.

一个继承的子线程类，接受主线程消息并执行：
unit UnitSubThread; { 子线程测试单元 } interface uses UnitBaseThread, SysUtils; type TMessageObj = class(TObject) public msg: string; index: Integer; end; {$M+} TSubThread = class(TBaseThread) private FIndex: Integer; procedure doHelloSub(mainSays: Cardinal); //RTTI反射执行的操作，命名为 do+[property定义名] published constructor Create; property helloSub: Cardinal write doHelloSub; //名称决定了postThreadData给当前线程时要调用的方法 end; {$M-} var subThread: TSubThread; implementation constructor TSubThread.Create; begin inherited Create(False); FIndex := 0; end; procedure TSubThread.doHelloSub(mainSays: Cardinal); var AMessageObj: TMessageObj; pStr: PChar; begin pStr := PChar(mainSays); Inc(FIndex); AMessageObj := TMessageObj.Create; AMessageObj.msg := StrPas(pStr); AMessageObj.index := FIndex; Sleep(5000); //休眠5秒 postMainForm('helloMain', Pointer(AMessageObj)); //将对象发送给主线程 FreeMemory(pStr); //别忘记释放消息队列里指向的对象 end; end.

主线程Form的实现，接受子线程的消息：
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, TypInfo, UnitSubThread; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; Edit1: TEdit; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private procedure receiveThreadMessage(var Msg: TMessage); message WM_USER; //接受其它线程发送消息 procedure dispatchMessageData(const command:string; data: Integer); procedure doHelloMain(MessageObj: TMessageObj); { Private declarations } public { Public declarations } published property helloMain: TMessageObj write doHelloMain; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.receiveThreadMessage(var Msg: TMessage); var pStr: PChar; begin pStr := PChar(Msg.wParam); if Assigned(pStr) then begin try dispatchMessageData(StrPas(pStr), Msg.lParam); except end; FreeMemory(pStr); end; end; procedure TForm1.Button1Click(Sender: TObject); var helloStr: PChar; begin Memo1.Lines.Add('发送给子线程，等待返回'); helloStr := AllocMem(Length(Edit1.Text) + 1); StrCopy(helloStr, PChar(Edit1.Text)); subThread.postThreadData('helloSub', helloStr); end; procedure TForm1.dispatchMessageData(const command:string; data: Integer); var PropInfo: PPropInfo; begin PropInfo := GetPropInfo(Self,command); if PropInfo <> nil then SetOrdProp(Self, PropInfo, data); end; procedure TForm1.doHelloMain(MessageObj: TMessageObj); begin Memo1.Lines.Add(IntToStr(MessageObj.index)); Memo1.Lines.Add(MessageObj.msg); MessageObj.Free; //别忘记释放消息里的对象 end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); var Handles: array[0..0] of THandle; begin //WaitForSingleObject(saveVoiceThread.Handle,INFINITE); subThread.exitThread; Handles[0] := subThread.Handle; MsgWaitForMultipleObjects(1, Handles, False, INFINITE, MWMO_WAITALL); //等待子线程退出 end; procedure TForm1.FormCreate(Sender: TObject); begin subThread := TSubThread.Create; end; end.

截图

示例下载：
http://download.youkuaiyun.com/source/2824731