本例是把多个线程访问数据库的请求,全部阻塞到一个线程。
这是实际编程中常见的一种问题。
示例源码下载,所需支持单元均在源码中,且附详细说明。
TElegantThread 的父类是 TSimpleThread。
![](https://i-blog.csdnimg.cn/blog_migrate/8f900a89c6347c561fdf2122f13be562.gif)
![](https://i-blog.csdnimg.cn/blog_migrate/961ddebeb323a10fe0623af514929fc1.gif)
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.