线程杂谈3

(************************************************

(* Subject:    线程杂谈3

(* Author: linzhenqun(风)

(* Time:       2006-3-25

(* Blog:      http://blog.youkuaiyun.com/linzhengqun

(* E-mail: linzhengqun@163.com

(************************************************

 

前言

我在写完线程杂谈2之后，本来不再打算写关于线程的文章了，但由于项目中时时要与线程打交道，所以于实践中又领悟了一些技巧，于是又有了此篇。

 

学习Windows的消息循环

     我在做Call Center项目时，负责一个邮件服务器程序，座席端软件可以通过该邮件服务器收取邮件，也可以通过它发送邮件。发送邮件的时候我开始的设计是这样的，一个座席发送一封邮件过来，邮件服务器收到这封邮件后即启动一个线程负责将它发送出去，但这样做是有严重的性能问题的，假设如果有十个座席同时发送邮件，则邮件服务器必须启动十个线程，如果十个座席每个人同时发送几封邮件，邮件服务器即必须启动几十个线程，显然这样做是不符合实际的。

     有没有办法解决这个瓶颈呢，正当我苦苦思索的时候，想到了Windows的消息队列和消息循环，对于每一个应用程序，Windows都为它维护一个消息队列，当由于键盘鼠标等硬件事件发生时，windows将相应的消息结构加入到应用程序的消息队列中。如果我们写过Windows的程序，就知道它的入口函数中必须有一个循环，不断地从消息队列中取出消息，然后发送至处理该消息函数中。

     这样的技术很好的解决了并发性带来的问题，使得每个动作都必须排队，那么发送邮件其实也可以用这样的技术来解决：程序运行的过程中，有一个负责发送邮件的工作线程，它一直循环从发送队列中取出发送邮件的简要信息，程序根据这个信息从数据库中取出邮件发送出去。不过这里得注意线程同步的问题，有可能在将发送信息加入队列的同时，线程正在取队列，所以要用一个临界区保证不会发生竞争条件。

     下面这个方法的示例代码：

unit Unit1;

interface

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

type
   //模拟邮件在数据库的信息
   PSendRec =^TSendRec;
   TSendRec = record
     SendID: string;
   end;
   TSendEvent = procedure(SendRec: PSendRec) of object;
   TSendTread = class(TThread)
   private
     FLock: TRTLCriticalSection;   //声明一个临界区变量
     FSendQue: TList; //发送结构的队列
     FSendRec: PSendRec;
     FSendEvent: TSendEvent;
     procedure Lock;
     procedure UnLock;
     procedure ClearQueue; //清除队列
     procedure SendAction(SendRec: PSendRec); //模拟发送的动作
   protected
     procedure Execute; override;
     procedure DoSend;
   public
     constructor Create(Suspend: Boolean);
     destructor Destroy; override;
     // 将一个发送结构加入队列
     procedure AddToQueue(SendRec: PSendRec);
     // 从队列中取出一个发送结构
     function PopFromQueue: PSendRec;
     property SendEvent: TSendEvent read FSendEvent write FSendEvent;
   end;

   TForm1 = class(TForm)
     btnSend: TButton;
     edtSendID: TEdit;
     edtSendResult: TEdit;
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure btnSendClick(Sender: TObject);
   private
     { Private declarations }
     SendThread: TSendTread;
     procedure OnSend(SendRec: PSendRec);
   public
     { Public declarations }
   end;

var
   Form1: TForm1;

implementation

{$R *.dfm}

{ TSendTread }

procedure TSendTread.AddToQueue(SendRec: PSendRec);
begin
   Lock;
   try
     FSendQue.Add(SendRec);
   finally
     UnLock;
   end;
end;

procedure TSendTread.ClearQueue;
var
   i: Integer;
begin
   for i := 0 to FSendQue.Count - 1 do
     Dispose(FSendQue[i]);
   FSendQue.Clear;
end;

constructor TSendTread.Create(Suspend: Boolean);
begin
   inherited Create(Suspend);
   InitializeCriticalSection(FLock);
   FSendQue := TList.Create;
end;

destructor TSendTread.Destroy;
begin
   //下面的技术在以前的文章已经说过了
   Terminate;
   WaitFor;

   ClearQueue;
   FSendQue.Free;
   DeleteCriticalSection(FLock);
   inherited;
end;

procedure TSendTread.DoSend;
begin
   if Assigned(FSendEvent) then
     FSendEvent(FSendRec);
end;

procedure TSendTread.Execute;
var
   SendRec: PSendRec;
begin
   while not Terminated do
   begin
     SendRec := PopFromQueue;
     if SendRec <> nil then
       SendAction(SendRec);
     Sleep(50); //稍作休息，避免占用CPU过多
   end;
end;

procedure TSendTread.Lock;
begin
   EnterCriticalSection(FLock);
end;

function TSendTread.PopFromQueue: PSendRec;
begin
   Result := nil;
   Lock;
   try
     if FSendQue.Count > 0 then
     begin
       Result := FSendQue[0];
       FSendQue.Delete(0);
     end;
   finally
     UnLock;
   end;
end;

procedure TSendTread.SendAction(SendRec: PSendRec);
begin
   FSendRec := SendRec;
   Synchronize(DoSend);
   Dispose(SendRec);
   Sleep(500);
end;

procedure TSendTread.UnLock;
begin
   LeaveCriticalSection(FLock);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   edtSendID.Text := '0';
   SendThread := TSendTread.Create(True);
   SendThread.SendEvent := OnSend;
   SendThread.Resume;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   SendThread.Free;
end;

procedure TForm1.OnSend(SendRec: PSendRec);
begin
   //接收事件，显示已经处理完的ID
   edtSendResult.Text := SendRec^.SendID;
end;

procedure TForm1.btnSendClick(Sender: TObject);
var
   SendRec: PSendRec;
   i: Integer;
begin
   New(SendRec);
   SendRec^.SendID := edtSendID.Text;
   //重生成一个ID，递增
   i := StrToInt(edtSendID.Text);
   Inc(i);
   edtSendID.Text := IntToStr(i);
   SendThread.AddToQueue(SendRec);
end;

end.

代码中用SendRec模拟发送的结构，里面只是一个简单的SendID，线程类中有AddToQueue和PopFromQueue两个方法，分别是将一个结构加进队列尾和从队列头取出一个结构，这两个方法用Lock和UnLock将操作锁起来，成为一个原子操作防止竞争条件的出现。而 Execute的操作就是不断的循环从队列取结构，如果队列不为空，将取出的结构传递给SendAction方法，我们可以假定这个方法就是发送邮件的方法，为了显示效果，我特别在该方法中向外发布一个事件，以该结构为参数，回调完事件后，即可将该结构的内存清除。

再看主窗体，程序一开始就创建了线程类，用按钮模拟发送邮件的操作，快速连续的按BtnSend，将产生一个个发送结构，并赋给一个唯一的ID，然后进加线程的发送队列中。这时候线程检测到队列中有数据，马上处理并向主界面发送事件，主界面在事件中显示了该结构的ID。

这个过程很有趣，无论我们怎样疯狂的点击按钮，edtSendResult总是有条不紊地显示结构ID。

 

用并发的队列提高效率

     有经验的程序也许会看出来，用上面的方法虽然可以保证程序的性能，但效率可是低了很多，如果同时有一百封邮件在队列中，假如每发送一封邮件平均用时1秒，则第一百封邮件要过一分钟钟才能被发送，这显然实时性不够。程序有时就是这样，需要在各个方面作一个权衡，好象能量守恒定律一样，如果动能增加了则势能就减少了。我们可以平衡这种极端性，在保证程序的稳定性能同时，也要提高程序的效率。

     有什么办法呢，还是要用多线程来做，假设有一个线程池类，每一个线程维护一个有限的队列，如果一个线程的队列达到最大值时，就会将结构加到另一个线程的队列中，线程池类管理线程，如果线程数不足，它会自动生成新的线程提供使用，这类似于内存页的管理技术。

     在主程序中我们只和线程池类打交道，假设这个线程池为TsendTrdPool，将每一个SendID传送进TsendTrdPool的一个方法，同时要传进一个回调函数，TsendTrdPool会将其挂到线程类中，这样界面便可以显示Send的结果了。

     声明一个MaxQueLen常量，定义发送队列最大的长度，对于线程类来说，只需要在AddToQueue中加一个限制，如果队列已经达到MaxQueLen，则增加失败，上面的线程类实现代码不必作过多的修改，只需将AddToQueue改成下面的样子：

function TSendTread.AddToQueue(SendRec: PSendRec): Boolean;
begin
   Lock;
   try
     Result := FSendQue.Count < MaxQueLen;
     if Result then
       FSendQue.Add(SendRec);
   finally
     UnLock;
   end;
end;

我们假设MaxQueLen为10，接下来重点实现TsendTrdPool，且看下面的代码：

type
   ...
   TSendTrdPool = class
   private
     FSendTrdList: TList;
     //清除发送线程
     procedure ClearSendThreadList;
     //创建一个新的线程类
     function CreateNewThread: TSendTread;
     function GetCount: Integer;
   public
     //加进发送记录，并传进一个回调函数
     procedure AddSendRec(SendRec: PSendRec; ASendEvent: TSendEvent);
     constructor Create;
     destructor Destroy; override;
     property Count: Integer read GetCount;
   end;

implementation
...
{ TSendTrdPool }

procedure TSendTrdPool.AddSendRec(SendRec: PSendRec;
   ASendEvent: TSendEvent);
var
   Succ: Boolean;
   i: Integer;
   SendThread: TSendTread;
begin
   Succ := False;
   for i := 0 to FSendTrdList.Count - 1 do
   begin
     SendThread := TSendTread(FSendTrdList[i]);
     SendThread.Lock;
     try
       if SendThread.AddToQueue(SendRec) then
       begin
         Succ := True;
         SendThread.SendEvent := ASendEvent;
         Break;
       end;
     finally
       SendThread.UnLock;
     end;
   end;
   if not Succ then
   begin
     SendThread := CreateNewThread;
     SendThread.SendEvent := ASendEvent;
     SendThread.AddToQueue(SendRec);
   end;
end;

procedure TSendTrdPool.ClearSendThreadList;
var
   i: Integer;
begin
   for i := 0 to FSendTrdList.Count - 1 do
     TSendTread(FSendTrdList[i]).Free;
end;

constructor TSendTrdPool.Create;
begin
   FSendTrdList := TList.Create;
end;

function TSendTrdPool.CreateNewThread: TSendTread;
begin
   Result := TSendTread.Create(False);
   FSendTrdList.Add(Result);
end;

destructor TSendTrdPool.Destroy;
begin
   ClearSendThreadList;
   FSendTrdList.Free;
   inherited;
end;

function TSendTrdPool.GetCount: Integer;
begin
   Result := FSendTrdList.Count;
end;

end.

这个类保存一个发送线程列表，初始化时这个列表为0，当AddSendRec被调用时，它会把一个发送结构和事件尝试加进列表中的某个线程，如果加入失败，表明所有线程的发送队列均已达到最大值，此时线程池类自动增加一个新的线程，并将发送结构加进这个类中。具体可看上面的实现代码，其中有一点要注意，如果增加了的线程将不会被消毁，只有到线程池类被消毁时，所有线程才被消毁。

现在我们来看看主界面的反应，在主窗体创建时生成一个TsendTrdPool，程序结束时消毁它，界面有一个按钮，其事件代码如下：

procedure TForm1.btnSendClick(Sender: TObject);
var
   SendRec: PSendRec;
   i: Integer;
begin
   for i := 0 to 99 do
   begin
     New(SendRec);
     SendRec^.SendID := IntToStr(i);
     SendTrdPool.AddSendRec(SendRec, OnSend);
   end;
   //显示线程池中的线程数
   edtThreadCount.Text := IntToStr(SendTrdPool.Count);
end;

点击一下按钮，将生成100个发送结构，在Edit中会显示一共有多少个线程，点击一下，一般生成10个线程，快速地点击两下，一般生成18或19 个线程，这是很容易理解的，因为在点击的过程中，某个线程的发送队列已有空余，所以不需要产生新的线程，所以点击的次数越多，线程增长会越慢。

所以这个技术是很有用的，可以有效地提高发送的效率，同时也减少线程的数量，达到某种奇妙的平衡效果。

也许有会问，如果邮件同时发送非常非常多，线程一样会有非常多的数量，我想这个情况应该是极少会出现，且邮件同时发送越多，线程增长的速度是越慢的，因为线程也一边在发送邮件，队列也一边在减少啊。如果真的要追究这个问题，还是有办法可以解决的，即线程池中的线程数量也是有限的，而同时线程池类中有另一个线程假设为AddThread，它的职责就是将发送结构加进某个发送线程中，当发送线程数没有达到极限时，它当然可以很快地把发送结构加进去，如果线程数达到极限，则它会一直循环去判断哪个发送线程的队列有空余，发现之后再加进去。这样可算将线程发挥到另一个层次了，不过我想程序要想复杂到这个程度还是比较少见的，兴趣的你可以自己去实现吧。

 

后记

     关于线程的应用实在是太多了，我想，线程杂谈也许还会有第四篇，第五篇，不过这些方法大多来源于实践，都是为了解决某些问题而进行思考，借鉴以及尝试的结果。有很多经典的技术其实很值得借鉴，我们有时候看看VCL，想想Win32，都能从中得到很多启发，所以，多体会一些成熟的思想，多阅读一些成功的代码，将会使你的技术大大提高。