1 unit uElegantThread;
  2 
  3 interface
  4 
  5 uses
  6   Classes, SysUtils, uSimpleThread, uSimpleList, uSyncObjs;
  7 
  8 type
  9 
 10   PSyncRec = ^TSyncRec;
 11 
 12   TSyncRec = record
 13     FMethod: TThreadMethod;
 14     FProcedure: TThreadProcedure;
 15     FSignal: TSuperEvent;
 16     Queued: boolean;
 17     DebugInfo: string;
 18   end;
 19 
 20   TSyncRecList = Class(TSimpleList<PSyncRec>)
 21   protected
 22     procedure FreeItem(Item: PSyncRec); override;
 23   End;
 24 
 25   TElegantThread = class(TSimpleThread)
 26   private
 27     FSyncRecList: TSyncRecList;
 28 
 29     procedure LockList;
 30     procedure UnlockList;
 31 
 32     procedure Check;
 33     procedure DoCheck;
 34 
 35   public
 36 
 37     // AAllowedActiveX 允许此线程访问 COM 如：IE ,
 38     // 当然，获取 Ie 的 IHtmlDocument2 接口，也必须在此线程内执行
 39     constructor Create(AAllowedActiveX: boolean = false);
 40     destructor Destroy; override;
 41 
 42     // ADebugInfo 是调用者用来查错用，一般可以写上过程名 如：'DoSomeThing';
 43     procedure Queue(AMethod: TThreadMethod; ADebugInfo: string = ''); overload;
 44     procedure Queue(AProcedure: TThreadProcedure; ADebugInfo: string = ''); overload;
 45 
 46     procedure Synchronize(AMethod: TThreadMethod; ADebugInfo: string = ''); overload;
 47     procedure Synchronize(AProcedure: TThreadProcedure; ADebugInfo: string = ''); overload;
 48 
 49   end;
 50 
 51 implementation
 52 
 53 { TSyncRecList }
 54 
 55 procedure TSyncRecList.FreeItem(Item: PSyncRec);
 56 begin
 57   inherited;
 58   if Assigned(Item.FSignal) then
 59     Item.FSignal.Free;
 60   Dispose(Item);
 61 end;
 62 
 63 { TElegantThread }
 64 
 65 procedure TElegantThread.Check;
 66 begin
 67   ExeProcInThread(DoCheck);
 68 end;
 69 
 70 constructor TElegantThread.Create(AAllowedActiveX: boolean);
 71 begin
 72   inherited;
 73   FSyncRecList := TSyncRecList.Create;
 74 end;
 75 
 76 destructor TElegantThread.Destroy;
 77 begin
 78   WaitThreadStop;
 79   FSyncRecList.Free;
 80   inherited;
 81 end;
 82 
 83 procedure TElegantThread.DoCheck;
 84 var
 85   p: PSyncRec;
 86   sErrMsg: string;
 87 begin
 88 
 89   LockList;
 90   try
 91     p := FSyncRecList.PopFirst; // 每次从 List 取出一个过程来执行
 92   finally
 93     UnlockList;
 94   end;
 95 
 96   if Assigned(p) then
 97   begin
 98 
 99     try
100 
101       if Assigned(p.FMethod) then
102         p.FMethod // 执行
103       else if Assigned(p.FProcedure) then
104         p.FProcedure(); // 执行
105 
106     except
107       on E: Exception do // 错误处理
108       begin
109         sErrMsg := 'DebugInfo:' + p.DebugInfo + #13#10;
110         sErrMsg := sErrMsg + 'ErrMsg:' + E.Message;
111         DoOnDebugMsg(sErrMsg);
112       end;
113     end;
114 
115     if not p.Queued then // 如果是阻塞，请设为有信号，调用者即可返回
116     begin
117       p.FSignal.SetEvent;
118     end;
119 
120     Dispose(p);
121     Check; // 继续下一次 DoCheck,也就是本过程。
122     // 父类 TSimpleThread 已特殊处理，不会递归。
123 
124   end;
125 
126 end;
127 
128 procedure TElegantThread.LockList;
129 begin
130   FSyncRecList.Lock;
131 end;
132 
133 procedure TElegantThread.Queue(AMethod: TThreadMethod; ADebugInfo: string);
134 var
135   p: PSyncRec;
136 begin
137   // 此过程为排队执行
138 
139   new(p);
140   p.FProcedure := nil;
141   p.FMethod := AMethod;
142   p.Queued := true;
143 
144   LockList;
145   try
146     FSyncRecList.Add(p); // 把要执行的过程加入 List
147     Check; // 启动线程
148   finally
149     UnlockList;
150   end;
151 
152 end;
153 
154 procedure TElegantThread.Queue(AProcedure: TThreadProcedure; ADebugInfo: string);
155 var
156   p: PSyncRec;
157 begin
158   new(p);
159   p.FProcedure := AProcedure;
160   p.FMethod := nil;
161   p.Queued := true;
162   LockList;
163   try
164     FSyncRecList.Add(p);
165     Check;
166   finally
167     UnlockList;
168   end;
169 end;
170 
171 procedure TElegantThread.Synchronize(AMethod: TThreadMethod; ADebugInfo: string);
172 var
173   p: PSyncRec;
174   o: TSuperEvent;
175 begin
176 
177   // 此过程为阻塞执行，即调用者必须等到此过程被执行完成才能返回
178 
179   new(p);
180 
181   p.FProcedure := nil;
182   p.FMethod := AMethod;
183   p.Queued := false;
184   p.FSignal := TSuperEvent.Create; // 创建一个信号
185   p.FSignal.ResetEvent; // 清除信号
186   o := p.FSignal;
187 
188   LockList;
189   try
190     FSyncRecList.Add(p);
191     Check;
192   finally
193     UnlockList;
194   end;
195 
196   o.WaitFor; // 等待信号出现
197   o.Free;
198 
199 end;
200 
201 procedure TElegantThread.Synchronize(AProcedure: TThreadProcedure; ADebugInfo: string);
202 var
203   p: PSyncRec;
204   o: TSuperEvent;
205 begin
206   new(p);
207 
208   p.FProcedure := AProcedure;
209   p.FMethod := nil;
210   p.Queued := false;
211   p.FSignal := TSuperEvent.Create;
212   p.FSignal.ResetEvent;
213   o := p.FSignal;
214 
215   LockList;
216   try
217     FSyncRecList.Add(p);
218     Check;
219   finally
220     UnlockList;
221   end;
222 
223   o.WaitFor;
224   o.Free;
225 
226 end;
227 
228 procedure TElegantThread.UnlockList;
229 begin
230   FSyncRecList.Unlock;
231 end;
232 
233 end.