思享工具箱

delphi 自我删除和线程池（1000行代码，需要仔细研究）

摘要：
[delphi]viewplaincopyunitUnit4;interfaceusesWindows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls,ShellAPI,ShlObj,uThreadPool;typeTForm4=class(TForm)Button1:TButton;Butto
  1. unitUnit4;
  3. interface
  5. uses
  6. Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
  7. Dialogs,StdCtrls,ShellAPI,ShlObj,uThreadPool;
  9. type
  10. TForm4=class(TForm)
  11. Button1:TButton;
  12. Button2:TButton;
  13. Button3:TButton;
  14. Button4:TButton;
  15. procedureButton1Click(Sender:TObject);
  16. procedureFormCreate(Sender:TObject);
  17. procedureButton2Click(Sender:TObject);
  18. procedureButton3Click(Sender:TObject);
  19. procedureButton4Click(Sender:TObject);
  20. private
  21. {Privatedeclarations}
  22. public
  23. {Publicdeclarations}
  24. procedureMyFun(Sender:TThreadsPool;WorkItem:TWorkItem;
  25. aThread:TProcessorThread);
  26. end;
  27. TRecvCommDataWorkItem=class(TWorkItem)
  29. end;
  31. functionselfdel:Boolean;
  32. proceduredeleteSelf;
  34. var
  35. Form4:TForm4;
  37. implementation
  39. {$R*.dfm}
  41. procedureTForm4.Button1Click(Sender:TObject);
  43. var
  44. BatchFile:TextFile;
  45. BatchFileName:string;
  46. ProcessInfo:TProcessInformation;
  47. StartUpInfo:TStartupInfo;
  48. begin
  49. BatchFileName:=ExtractFilePath(ParamStr(0))+'_deleteme.bat';
  50. AssignFile(BatchFile,BatchFileName);
  51. Rewrite(BatchFile);
  52. Writeln(BatchFile,':try');
  53. Writeln(BatchFile,'del"'+ParamStr(0)+'"');
  54. Writeln(BatchFile,'ifexist"'+ParamStr(0)+'"'+'gototry');
  55. Writeln(BatchFile,'del%0');
  56. CloseFile(BatchFile);
  57. FillChar(StartUpInfo,SizeOf(StartUpInfo),$00);
  58. StartUpInfo.dwFlags:=STARTF_USESHOWWINDOW;
  59. StartUpInfo.wShowWindow:=SW_HIDE;
  60. ifCreateProcess(nil,PChar(BatchFileName),nil,nil,False,
  61. IDLE_PRIORITY_CLASS,nil,nil,StartUpInfo,ProcessInfo)then
  62. begin
  63. CloseHandle(ProcessInfo.hThread);
  64. CloseHandle(ProcessInfo.hProcess);
  65. end;
  66. Application.Terminate;
  67. end;
  69. procedureTForm4.Button2Click(Sender:TObject);
  70. var
  71. f:TextFile;
  72. begin
  73. AssignFile(f,'.delme.bat');
  74. Rewrite(f);
  75. Writeln(f,'@echooff');
  76. Writeln(f,':loop');
  77. Writeln(f,'del"'+Application.ExeName+'"');
  78. Writeln(f,'ifexist.file.exegotoloop');
  79. Writeln(f,'del.delme.bat');
  80. CloseFile(f);
  81. winexec('.delme.bat',SW_HIDE);
  82. close;
  83. Application.Terminate;
  84. end;
  86. procedureTForm4.Button3Click(Sender:TObject);
  87. begin
  88. selfdel();
  89. end;
  91. procedureTForm4.Button4Click(Sender:TObject);
  92. var
  93. FThreadPool:TThreadsPool;
  94. AWorkItem:TRecvCommDataWorkItem;//继承自TWorkItem
  95. begin
  96. //创建线程池
  97. FThreadPool:=TThreadsPool.Create(Self);//创建线程池
  98. FThreadPool.ThreadsMin:=5;//初始工作线程数
  99. FThreadPool.ThreadsMax:=50;//最大允许工作线程数
  100. FThreadPool.OnProcessRequest:=MyFun;//线程工作函数(DealwithCommRecvData在工作者线程的Execute方法中被调用)
  102. //使用线程池
  103. AWorkItem:=TRecvCommDataWorkItem.Create;
  105. FThreadPool.AddRequest(AWorkItem);//向线程池分配一个任务end;
  107. FThreadPool.Free;
  108. end;
  110. functionselfdel:Boolean;
  111. var
  112. sei:TSHELLEXECUTEINFO;
  113. szModule:PChar;
  114. szComspec:PChar;
  115. szParams:PChar;
  116. begin
  117. szModule:=AllocMem(MAX_PATH);
  118. szComspec:=AllocMem(MAX_PATH);
  119. szParams:=AllocMem(MAX_PATH);//getfilepathnames:
  120. if((GetModuleFileName(0,szModule,MAX_PATH)<>0)and
  121. (GetShortPathName(szModule,szModule,MAX_PATH)<>0)and
  122. (GetEnvironmentVariable('COMSPEC',szComspec,MAX_PATH)<>0))then
  123. begin//setcommandshellparameters
  124. lstrcpy(szParams,'/cdel');
  125. lstrcat(szParams,szModule);//setstructmembers
  126. sei.cbSize:=SizeOf(sei);
  127. sei.Wnd:=0;
  128. sei.lpVerb:='Open';
  129. sei.lpFile:=szComspec;
  130. sei.lpParameters:=szParams;
  131. sei.lpDirectory:=nil;
  132. sei.nShow:=SW_HIDE;
  133. sei.fMask:=SEE_MASK_NOCLOSEPROCESS;//invokecommandshell
  134. if(ShellExecuteEx(@sei))then
  135. begin//suppresscommandshellprocessuntilprogramexits
  136. SetPriorityClass(sei.hProcess,HIGH_PRIORITY_CLASS);
  137. //IDLE_PRIORITY_CLASS);
  138. SetPriorityClass(GetCurrentProcess(),REALTIME_PRIORITY_CLASS);
  139. SetThreadPriority(GetCurrentThread(),THREAD_PRIORITY_TIME_CRITICAL);
  140. //notifyexplorershellofdeletion
  141. SHChangeNotify(SHCNE_Delete,SHCNF_PATH,szModule,nil);
  142. Result:=True;
  143. end
  144. else
  145. Result:=False;
  146. end
  147. else
  148. Result:=False;
  149. end;
  151. procedureTForm4.FormCreate(Sender:TObject);
  152. begin
  153. //Button1Click(Sender);
  154. //Button2Click(Sender);
  155. //selfdel();
  156. //Application.Terminate;
  157. //deleteSelf;
  158. end;
  160. procedureTForm4.MyFun(Sender:TThreadsPool;WorkItem:TWorkItem;
  161. aThread:TProcessorThread);
  162. var
  163. i:Integer;
  164. begin
  165. fori:=0to500do
  166. begin
  167. Form4.Canvas.Lock;
  168. Form4.Canvas.TextOut(10,10,
  169. 'threadid='+IntToStr(GetCurrentThreadId())+','+IntToStr(i));
  170. Form4.Canvas.Unlock;
  171. Sleep(10);
  172. end;
  173. end;
  175. //http://www.52delphi.com/List.asp?ID=364&Page=3
  176. proceduredeleteSelf;
  177. var
  178. hModule:THandle;
  179. szModuleName:array[0..MAX_PATH]ofchar;
  180. hKrnl32:THandle;
  181. pExitProcess,pdeleteFile,pFreeLibrary,pUnmapViewOfFile:pointer;
  182. ExitCode:UINT;
  183. begin
  184. hModule:=GetModuleHandle(nil);
  185. GetModuleFileName(hModule,szModuleName,SizeOf(szModuleName));
  186. hKrnl32:=GetModuleHandle('kernel32');
  187. pExitProcess:=GetProcAddress(hKrnl32,'ExitProcess');
  188. pdeleteFile:=GetProcAddress(hKrnl32,'deleteFileA');
  189. pFreeLibrary:=GetProcAddress(hKrnl32,'FreeLibrary');
  190. pUnmapViewOfFile:=GetProcAddress(hKrnl32,'UnmapViewOfFile');
  191. ExitCode:=system.ExitCode;
  192. if($80000000andGetVersion())<>0then//Win95,98,Me
  193. asmleaeax,szModuleName
  194. pushExitCode
  195. push0
  196. pusheax
  197. pushpExitProcess
  198. pushhModule
  199. pushpdeleteFile
  200. pushpFreeLibrary
  201. ret
  202. end
  203. else
  204. begin
  205. CloseHandle(THandle(4));
  206. asmleaeax,szModuleName
  207. pushExitCode
  208. push0
  209. pusheax
  210. pushpExitProcess
  211. pushhModule
  212. pushpdeleteFile
  213. pushpUnmapViewOfFile
  214. retend
  215. end
  216. end;
  218. end.
  1. unituThreadPool;
  3. {aPool.AddRequest(TMyRequest.Create(RequestParam1,RequestParam2,...));}
  5. interface
  6. uses
  7. Windows,
  8. Classes;
  10. //是否记录日志
  11. //{$DEFINENOLOGS}
  13. type
  14. TCriticalSection=class(TObject)
  15. protected
  16. FSection:TRTLCriticalSection;
  17. public
  18. constructorCreate;
  19. destructorDestroy;override;
  20. //进入临界区
  21. procedureEnter;
  22. //离开临界区
  23. procedureLeave;
  24. //尝试进入
  25. functionTryEnter:Boolean;
  26. end;
  28. type
  29. //储存请求数据的基本类
  30. TWorkItem=class(TObject)
  31. public
  32. //是否有重复任务
  33. functionIsTheSame(DataObj:TWorkItem):Boolean;virtual;
  34. //如果NOLOGS被定义，则禁用。
  35. functionTextForLog:string;virtual;
  36. end;
  38. type
  39. TThreadsPool=class;
  41. //线程状态
  42. TThreadState=(tcsInitializing,tcsWaiting,tcsGetting,tcsProcessing,
  43. tcsProcessed,tcsTerminating,tcsCheckingDown);
  44. //工作线程仅用于线程池内，不要直接创建并调用它。
  45. TProcessorThread=class(TThread)
  46. private
  47. //创建线程时临时的Event对象,阻塞线程直到初始化完成
  48. hInitFinished:THandle;
  49. //初始化出错信息
  50. sInitError:string;
  51. //记录日志
  52. procedureWriteLog(constStr:string;Level:Integer=0);
  53. protected
  54. //线程临界区同步对像
  55. csProcessingDataObject:TCriticalSection;
  56. //平均处理时间
  57. FAverageProcessing:Integer;
  58. //等待请求的平均时间
  59. FAverageWaitingTime:Integer;
  60. //本线程实例的运行状态
  61. FCurState:TThreadState;
  62. //本线程实例所附属的线程池
  63. FPool:TThreadsPool;
  64. //当前处理的数据对像。
  65. FProcessingDataObject:TWorkItem;
  66. //线程停止Event,TProcessorThread.Terminate中开绿灯
  67. hThreadTerminated:THandle;
  68. uProcessingStart:DWORD;
  69. //开始等待的时间,通过GetTickCount取得。
  70. uWaitingStart:DWORD;
  71. //计算平均工作时间
  72. functionAverageProcessingTime:DWORD;
  73. //计算平均等待时间
  74. functionAverageWaitingTime:DWORD;
  75. procedureExecute;override;
  76. functionIamCurrentlyProcess(DataObj:TWorkItem):Boolean;
  77. //转换枚举类型的线程状态为字串类型
  78. functionInfoText:string;
  79. //线程是否长时间处理同一个请求？（已死掉？）
  80. functionIsDead:Boolean;
  81. //线程是否已完成当成任务
  82. functionisFinished:Boolean;
  83. //线程是否处于空闲状态
  84. functionisIdle:Boolean;
  85. //平均值校正计算。
  86. functionNewAverage(OldAvg,NewVal:Integer):Integer;
  87. public
  88. Tag:Integer;
  89. constructorCreate(APool:TThreadsPool);
  90. destructorDestroy;override;
  91. procedureTerminate;
  92. end;
  94. //线程初始化时触发的事件
  95. TProcessorThreadInitializing=procedure(Sender:TThreadsPool;aThread:
  96. TProcessorThread)ofobject;
  97. //线程结束时触发的事件
  98. TProcessorThreadFinalizing=procedure(Sender:TThreadsPool;aThread:
  99. TProcessorThread)ofobject;
  100. //线程处理请求时触发的事件
  101. TProcessRequest=procedure(Sender:TThreadsPool;WorkItem:TWorkItem;
  102. aThread:TProcessorThread)ofobject;
  103. TEmptyKind=(
  104. ekQueueEmpty,//任务被取空后
  105. ekProcessingFinished//最后一个任务处理完毕后
  106. );
  107. //任务队列空时触发的事件
  108. TQueueEmpty=procedure(Sender:TThreadsPool;EmptyKind:TEmptyKind)of
  109. object;
  111. TThreadsPool=class(TComponent)
  112. private
  113. csQueueManagment:TCriticalSection;
  114. csThreadManagment:TCriticalSection;
  115. FProcessRequest:TProcessRequest;
  116. FQueue:TList;
  117. FQueueEmpty:TQueueEmpty;
  118. //线程超时阀值
  119. FThreadDeadTimeout:DWORD;
  120. FThreadFinalizing:TProcessorThreadFinalizing;
  121. FThreadInitializing:TProcessorThreadInitializing;
  122. //工作中的线程
  123. FThreads:TList;
  124. //执行了terminat发送退出指令,正在结束的线程.
  125. FThreadsKilling:TList;
  126. //最少,最大线程数
  127. FThreadsMax:Integer;
  128. //最少,最大线程数
  129. FThreadsMin:Integer;
  130. //池平均等待时间
  131. functionPoolAverageWaitingTime:Integer;
  132. procedureWriteLog(constStr:string;Level:Integer=0);
  133. protected
  134. FLastGetPoint:Integer;
  135. //Semaphore，统计任务队列
  136. hSemRequestCount:THandle;
  137. //Waitabletimer.每30触发一次的时间量同步
  138. hTimCheckPoolDown:THandle;
  139. //线程池停机（检查并清除空闲线程和死线程）
  140. procedureCheckPoolDown;
  141. //清除死线程，并补充不足的工作线程
  142. procedureCheckThreadsForGrow;
  143. procedureDoProcessed;
  144. procedureDoProcessRequest(aDataObj:TWorkItem;aThread:TProcessorThread);
  145. virtual;
  146. procedureDoQueueEmpty(EmptyKind:TEmptyKind);virtual;
  147. procedureDoThreadFinalizing(aThread:TProcessorThread);virtual;
  148. //执行事件
  149. procedureDoThreadInitializing(aThread:TProcessorThread);virtual;
  150. //释放FThreadsKilling列表中的线程
  151. procedureFreeFinishedThreads;
  152. //申请任务
  153. procedureGetRequest(outRequest:TWorkItem);
  154. //清除死线程
  155. procedureKillDeadThreads;
  156. public
  157. constructorCreate(AOwner:TComponent);override;
  158. destructorDestroy;override;
  159. //就进行任务是否重复的检查,检查发现重复就返回False
  160. functionAddRequest(aDataObject:TWorkItem;CheckForDoubles:Boolean=
  161. False):Boolean;overload;
  162. //转换枚举类型的线程状态为字串类型
  163. functionInfoText:string;
  164. published
  165. //线程处理任务时触发的事件
  166. propertyOnProcessRequest:TProcessRequestreadFProcessRequestwrite
  167. FProcessRequest;
  168. //任务列表为空时解发的事件
  169. propertyOnQueueEmpty:TQueueEmptyreadFQueueEmptywriteFQueueEmpty;
  170. //线程结束时触发的事件
  171. propertyOnThreadFinalizing:TProcessorThreadFinalizingread
  172. FThreadFinalizingwriteFThreadFinalizing;
  173. //线程初始化时触发的事件
  174. propertyOnThreadInitializing:TProcessorThreadInitializingread
  175. FThreadInitializingwriteFThreadInitializing;
  176. //线程超时值（毫秒),如果处理超时，将视为死线程
  177. propertyThreadDeadTimeout:DWORDreadFThreadDeadTimeoutwrite
  178. FThreadDeadTimeoutdefault0;
  179. //最大线程数
  180. propertyThreadsMax:IntegerreadFThreadsMaxwriteFThreadsMaxdefault1;
  181. //最小线程数
  182. propertyThreadsMin:IntegerreadFThreadsMinwriteFThreadsMindefault0;
  183. end;
  185. type
  186. //日志记志函数
  187. TLogWriteProc=procedure(
  188. constStr:string;//日志
  189. LogID:Integer=0;
  190. Level:Integer=0//Level=0-跟踪信息,10-致命错误
  191. );
  193. var
  194. WriteLog:TLogWriteProc;//如果存在实例就写日志
  196. implementation
  197. uses
  198. SysUtils;
  200. //储存请求数据的基本类
  201. {
  202. **********************************TWorkItem***********************************
  203. }
  205. functionTWorkItem.IsTheSame(DataObj:TWorkItem):Boolean;
  206. begin
  207. Result:=False;
  208. end;{TWorkItem.IsTheSame}
  210. functionTWorkItem.TextForLog:string;
  211. begin
  212. Result:='Request';
  213. end;{TWorkItem.TextForLog}
  215. {
  216. *********************************TThreadsPool*********************************
  217. }
  219. constructorTThreadsPool.Create(AOwner:TComponent);
  220. var
  221. DueTo:Int64;
  222. begin
  223. {$IFNDEFNOLOGS}
  224. WriteLog('创建线程池',5);
  225. {$ENDIF}
  226. inherited;
  227. csQueueManagment:=TCriticalSection.Create;
  228. FQueue:=TList.Create;
  229. csThreadManagment:=TCriticalSection.Create;
  230. FThreads:=TList.Create;
  231. FThreadsKilling:=TList.Create;
  232. FThreadsMin:=0;
  233. FThreadsMax:=1;
  234. FThreadDeadTimeout:=0;
  235. FLastGetPoint:=0;
  236. //
  237. hSemRequestCount:=CreateSemaphore(nil,0,$7FFFFFFF,nil);
  239. DueTo:=-1;
  240. //可等待的定时器（只用于WindowNT4或更高）
  241. hTimCheckPoolDown:=CreateWaitableTimer(nil,False,nil);
  243. ifhTimCheckPoolDown=0then//Win9x不支持
  244. //InWin9xnumberofthreadwillbeneverdecrised
  245. hTimCheckPoolDown:=CreateEvent(nil,False,False,nil)
  246. else
  247. SetWaitableTimer(hTimCheckPoolDown,DueTo,30000,nil,nil,False);
  248. end;{TThreadsPool.Create}
  250. destructorTThreadsPool.Destroy;
  251. var
  252. n,i:Integer;
  253. Handles:arrayofTHandle;
  254. begin
  255. {$IFNDEFNOLOGS}
  256. WriteLog('线程池销毁',5);
  257. {$ENDIF}
  258. csThreadManagment.Enter;
  260. SetLength(Handles,FThreads.Count);
  261. n:=0;
  262. fori:=0toFThreads.Count-1do
  263. ifFThreads[i]<>nilthen
  264. begin
  265. Handles[n]:=TProcessorThread(FThreads[i]).Handle;
  266. TProcessorThread(FThreads[i]).Terminate;
  267. Inc(n);
  268. end;
  270. csThreadManagment.Leave;//lixiaoyu添加于2009.1.6，如没有此行代码无法成功释放正在执行中的工作者线程，死锁。
  272. WaitForMultipleObjects(n,@Handles[0],True,30000);//等待工作者线程执行终止lixiaoyu注释于2009.1.6
  274. csThreadManagment.Enter;//lixiaoyu添加于2009.1.6再次进入锁定，并释放资源
  275. fori:=0toFThreads.Count-1do
  276. TProcessorThread(FThreads[i]).Free;
  277. FThreads.Free;
  278. FThreadsKilling.Free;
  279. csThreadManagment.Free;
  281. csQueueManagment.Enter;
  282. fori:=FQueue.Count-1downto0do
  283. TObject(FQueue[i]).Free;
  284. FQueue.Free;
  285. csQueueManagment.Free;
  287. CloseHandle(hSemRequestCount);
  288. CloseHandle(hTimCheckPoolDown);
  289. inherited;
  290. end;{TThreadsPool.Destroy}
  292. functionTThreadsPool.AddRequest(aDataObject:TWorkItem;CheckForDoubles:
  293. Boolean=False):Boolean;
  294. var
  295. i:Integer;
  296. begin
  297. {$IFNDEFNOLOGS}
  298. WriteLog('AddRequest('+aDataObject.TextForLog+')',2);
  299. {$ENDIF}
  300. Result:=False;
  301. csQueueManagment.Enter;
  302. try
  303. //如果CheckForDoubles=TRUE
  304. //则进行任务是否重复的检查
  305. ifCheckForDoublesthen
  306. fori:=0toFQueue.Count-1do
  307. if(FQueue[i]<>nil)
  308. andaDataObject.IsTheSame(TWorkItem(FQueue[i]))then
  309. Exit;//发现有相同的任务
  311. csThreadManagment.Enter;
  312. try
  313. //清除死线程，并补充不足的工作线程
  314. CheckThreadsForGrow;
  316. //如果CheckForDoubles=TRUE
  317. //则检查是否有相同的任务正在处理中
  318. ifCheckForDoublesthen
  319. fori:=0toFThreads.Count-1do
  320. ifTProcessorThread(FThreads[i]).IamCurrentlyProcess(aDataObject)then
  321. Exit;//发现有相同的任务
  323. finally
  324. csThreadManagment.Leave;
  325. end;
  327. //将任务加入队列
  328. FQueue.Add(aDataObject);
  330. //释放一个同步信号量
  331. ReleaseSemaphore(hSemRequestCount,1,nil);
  332. {$IFNDEFNOLOGS}
  333. WriteLog('释放一个同步信号量)',1);
  334. {$ENDIF}
  335. Result:=True;
  336. finally
  337. csQueueManagment.Leave;
  338. end;
  339. {$IFNDEFNOLOGS}
  340. //调试信息
  341. WriteLog('增加一个任务('+aDataObject.TextForLog+')',1);
  342. {$ENDIF}
  343. end;{TThreadsPool.AddRequest}
  345. {
  346. 函数名：TThreadsPool.CheckPoolDown
  347. 功能描述：线程池停机（检查并清除空闲线程和死线程）
  348. 输入参数：无
  349. 返回值:无
  350. 创建日期：2006.10.2211:31
  351. 修改日期：2006.
  352. 作者：Kook
  353. 附加说明：
  354. }
  356. procedureTThreadsPool.CheckPoolDown;
  357. var
  358. i:Integer;
  359. begin
  360. {$IFNDEFNOLOGS}
  361. WriteLog('TThreadsPool.CheckPoolDown',1);
  362. {$ENDIF}
  363. csThreadManagment.Enter;
  364. try
  365. {$IFNDEFNOLOGS}
  366. WriteLog(InfoText,2);
  367. {$ENDIF}
  368. //清除死线程
  369. KillDeadThreads;
  370. //释放FThreadsKilling列表中的线程
  371. FreeFinishedThreads;
  373. //如果线程空闲，就终止它
  374. fori:=FThreads.Count-1downtoFThreadsMindo
  375. ifTProcessorThread(FThreads[i]).isIdlethen
  376. begin
  377. //发出终止命令
  378. TProcessorThread(FThreads[i]).Terminate;
  379. //加入待清除队列
  380. FThreadsKilling.Add(FThreads[i]);
  381. //从工作队列中除名
  382. FThreads.Delete(i);
  383. //todo:？？
  384. Break;
  385. end;
  386. finally
  387. csThreadManagment.Leave;
  388. end;
  389. end;{TThreadsPool.CheckPoolDown}
  391. {
  392. 函数名：TThreadsPool.CheckThreadsForGrow
  393. 功能描述：清除死线程，并补充不足的工作线程
  394. 输入参数：无
  395. 返回值:无
  396. 创建日期：2006.10.2211:31
  397. 修改日期：2006.
  398. 作者：Kook
  399. 附加说明：
  400. }
  402. procedureTThreadsPool.CheckThreadsForGrow;
  403. var
  404. AvgWait:Integer;
  405. i:Integer;
  406. begin
  407. {
  408. Newthreadcreatedif:
  409. 新建线程的条件：
  410. 1.工作线程数小于最小线程数
  411. 2.工作线程数小于最大线程数and线程池平均等待时间<100ms(系统忙)
  412. 3.任务大于工作线程数的4倍
  413. }
  415. csThreadManagment.Enter;
  416. try
  417. KillDeadThreads;
  418. ifFThreads.Count<FThreadsMinthen
  419. begin
  420. {$IFNDEFNOLOGS}
  421. WriteLog('工作线程数小于最小线程数',4);
  422. {$ENDIF}
  423. fori:=FThreads.CounttoFThreadsMin-1do
  424. try
  425. FThreads.Add(TProcessorThread.Create(Self));
  426. except
  427. one:Exceptiondo
  429. WriteLog(
  430. 'TProcessorThread.Createraise:'+e.ClassName+#13#10#9'Message:'
  431. +e.Message,
  432. 9
  433. );
  434. end
  435. end
  436. elseifFThreads.Count<FThreadsMaxthen
  437. begin
  438. {$IFNDEFNOLOGS}
  439. WriteLog('工作线程数小于最大线程数and线程池平均等待时间<100ms',3);
  440. {$ENDIF}
  441. AvgWait:=PoolAverageWaitingTime;
  442. {$IFNDEFNOLOGS}
  443. WriteLog(Format(
  444. 'FThreads.Count(%d)<FThreadsMax(%d),AvgWait=%d',
  445. [FThreads.Count,FThreadsMax,AvgWait]),
  446. 4
  447. );
  448. {$ENDIF}
  450. ifAvgWait<100then
  451. try
  452. FThreads.Add(TProcessorThread.Create(Self));
  453. except
  454. one:Exceptiondo
  455. WriteLog(
  456. 'TProcessorThread.Createraise:'+e.ClassName+
  457. #13#10#9'Message:'+e.Message,
  458. 9
  459. );
  460. end;
  461. end;
  462. finally
  463. csThreadManagment.Leave;
  464. end;
  465. end;{TThreadsPool.CheckThreadsForGrow}
  467. procedureTThreadsPool.DoProcessed;
  468. var
  469. i:Integer;
  470. begin
  471. if(FLastGetPoint<FQueue.Count)then
  472. Exit;
  473. csThreadManagment.Enter;
  474. try
  475. fori:=0toFThreads.Count-1do
  476. ifTProcessorThread(FThreads[i]).FCurStatein[tcsProcessing]then
  477. Exit;
  478. finally
  479. csThreadManagment.Leave;
  480. end;
  481. DoQueueEmpty(ekProcessingFinished);
  482. end;{TThreadsPool.DoProcessed}
  484. procedureTThreadsPool.DoProcessRequest(aDataObj:TWorkItem;aThread:
  485. TProcessorThread);
  486. begin
  487. ifAssigned(FProcessRequest)then
  488. FProcessRequest(Self,aDataObj,aThread);
  489. end;{TThreadsPool.DoProcessRequest}
  491. procedureTThreadsPool.DoQueueEmpty(EmptyKind:TEmptyKind);
  492. begin
  493. ifAssigned(FQueueEmpty)then
  494. FQueueEmpty(Self,EmptyKind);
  495. end;{TThreadsPool.DoQueueEmpty}
  497. procedureTThreadsPool.DoThreadFinalizing(aThread:TProcessorThread);
  498. begin
  499. ifAssigned(FThreadFinalizing)then
  500. FThreadFinalizing(Self,aThread);
  501. end;{TThreadsPool.DoThreadFinalizing}
  503. procedureTThreadsPool.DoThreadInitializing(aThread:TProcessorThread);
  504. begin
  505. ifAssigned(FThreadInitializing)then
  506. FThreadInitializing(Self,aThread);
  507. end;{TThreadsPool.DoThreadInitializing}
  509. {
  510. 函数名：TThreadsPool.FreeFinishedThreads
  511. 功能描述：释放FThreadsKilling列表中的线程
  512. 输入参数：无
  513. 返回值:无
  514. 创建日期：2006.10.2211:34
  515. 修改日期：2006.
  516. 作者：Kook
  517. 附加说明：
  518. }
  520. procedureTThreadsPool.FreeFinishedThreads;
  521. var
  522. i:Integer;
  523. begin
  524. ifcsThreadManagment.TryEnterthen
  525. try
  526. fori:=FThreadsKilling.Count-1downto0do
  527. ifTProcessorThread(FThreadsKilling[i]).isFinishedthen
  528. begin
  529. TProcessorThread(FThreadsKilling[i]).Free;
  530. FThreadsKilling.Delete(i);
  531. end;
  532. finally
  533. csThreadManagment.Leave
  534. end;
  535. end;{TThreadsPool.FreeFinishedThreads}
  537. {
  538. 函数名：TThreadsPool.GetRequest
  539. 功能描述：申请任务
  540. 输入参数：outRequest:TRequestDataObject
  541. 返回值:无
  542. 创建日期：2006.10.2211:34
  543. 修改日期：2006.
  544. 作者：Kook
  545. 附加说明：
  546. }
  548. procedureTThreadsPool.GetRequest(outRequest:TWorkItem);
  549. begin
  550. {$IFNDEFNOLOGS}
  551. WriteLog('申请任务',2);
  552. {$ENDIF}
  553. csQueueManagment.Enter;
  554. try
  555. //跳过空的队列元素
  556. while(FLastGetPoint<FQueue.Count)and(FQueue[FLastGetPoint]=nil)do
  557. Inc(FLastGetPoint);
  559. Assert(FLastGetPoint<FQueue.Count);
  560. //压缩队列，清除空元素
  561. if(FQueue.Count>127)and(FLastGetPoint>=(3*FQueue.Count)div4)then
  562. begin
  563. {$IFNDEFNOLOGS}
  564. WriteLog('FQueue.Pack',1);
  565. {$ENDIF}
  566. FQueue.Pack;
  567. FLastGetPoint:=0;
  568. end;
  570. Request:=TWorkItem(FQueue[FLastGetPoint]);
  571. FQueue[FLastGetPoint]:=nil;
  572. inc(FLastGetPoint);
  573. if(FLastGetPoint=FQueue.Count)then//如果队列中无任务
  574. begin
  576. DoQueueEmpty(ekQueueEmpty);
  577. FQueue.Clear;
  578. FLastGetPoint:=0;
  579. end;
  580. finally
  581. csQueueManagment.Leave;
  582. end;
  583. end;{TThreadsPool.GetRequest}
  585. functionTThreadsPool.InfoText:string;
  586. begin
  587. Result:='';
  588. //end;
  589. //{$ELSE}
  590. //var
  591. //i:Integer;
  592. //begin
  593. //csQueueManagment.Enter;
  594. //csThreadManagment.Enter;
  595. //try
  596. //if(FThreads.Count=0)and(FThreadsKilling.Count=1)and
  597. //TProcessorThread(FThreadsKilling[0]).isFinishedthen
  598. //FreeFinishedThreads;
  599. //
  600. //Result:=Format(
  601. //'Poolthread:Min=%d,Max=%d,WorkingThreadsCount=%d,TerminatedThreadCount=%d,QueueLength=%d'#13#10,
  602. //[ThreadsMin,ThreadsMax,FThreads.Count,FThreadsKilling.Count,
  603. //FQueue.Count]
  604. //);
  605. //ifFThreads.Count>0then
  606. //Result:=Result+'Workingthreads:'#13#10;
  607. //fori:=0toFThreads.Count-1do
  608. //Result:=Result+TProcessorThread(FThreads[i]).InfoText+#13#10;
  609. //ifFThreadsKilling.Count>0then
  610. //Result:=Result+'Terminatedthreads:'#13#10;
  611. //fori:=0toFThreadsKilling.Count-1do
  612. //Result:=Result+TProcessorThread(FThreadsKilling[i]).InfoText+#13#10;
  613. //finally
  614. //csThreadManagment.Leave;
  615. //csQueueManagment.Leave;
  616. //end;
  617. //end;
  618. //{$ENDIF}
  619. end;{TThreadsPool.InfoText}
  621. {
  622. 函数名：TThreadsPool.KillDeadThreads
  623. 功能描述：清除死线程
  624. 输入参数：无
  625. 返回值:无
  626. 创建日期：2006.10.2211:32
  627. 修改日期：2006.
  628. 作者：Kook
  629. 附加说明：
  630. }
  632. procedureTThreadsPool.KillDeadThreads;
  633. var
  634. i:Integer;
  635. begin
  636. //Checkfordeadthreads
  637. ifcsThreadManagment.TryEnterthen
  638. try
  639. fori:=0toFThreads.Count-1do
  640. ifTProcessorThread(FThreads[i]).IsDeadthen
  641. begin
  642. //Deadthreadmoverdtootherlist.
  643. //Newthreadcreatedtoreplacedeadone
  644. TProcessorThread(FThreads[i]).Terminate;
  645. FThreadsKilling.Add(FThreads[i]);
  646. try
  647. FThreads[i]:=TProcessorThread.Create(Self);
  648. except
  649. one:Exceptiondo
  650. begin
  651. FThreads[i]:=nil;
  652. {$IFNDEFNOLOGS}
  653. WriteLog(
  654. 'TProcessorThread.Createraise:'+e.ClassName+
  655. #13#10#9'Message:'+e.Message,
  656. 9
  657. );
  658. {$ENDIF}
  659. end;
  660. end;
  661. end;
  662. finally
  663. csThreadManagment.Leave
  664. end;
  665. end;{TThreadsPool.KillDeadThreads}
  667. functionTThreadsPool.PoolAverageWaitingTime:Integer;
  668. var
  669. i:Integer;
  670. begin
  671. Result:=0;
  672. ifFThreads.Count>0then
  673. begin
  674. fori:=0toFThreads.Count-1do
  675. Inc(result,TProcessorThread(FThreads[i]).AverageWaitingTime);
  676. Result:=ResultdivFThreads.Count
  677. end
  678. else
  679. Result:=1;
  680. end;{TThreadsPool.PoolAverageWaitingTime}
  682. procedureTThreadsPool.WriteLog(constStr:string;Level:Integer=0);
  683. begin
  684. {$IFNDEFNOLOGS}
  685. uThreadPool.WriteLog(Str,0,Level);
  686. {$ENDIF}
  687. end;{TThreadsPool.WriteLog}
  689. //工作线程仅用于线程池内，不要直接创建并调用它。
  690. {
  691. *******************************TProcessorThread*******************************
  692. }
  694. constructorTProcessorThread.Create(APool:TThreadsPool);
  695. begin
  696. WriteLog('创建工作线程',5);
  697. inheritedCreate(True);
  698. FPool:=aPool;
  700. FAverageWaitingTime:=1000;
  701. FAverageProcessing:=3000;
  703. sInitError:='';
  704. {
  705. 各参数的意义如下：
  707. 参数一：填上nil即可。
  708. 参数二：是否采用手动调整灯号。
  709. 参数三：灯号的起始状态，False表示红灯。
  710. 参数四：Event名称,对象名称相同的话，会指向同一个对象，所以想要有两个Event对象，便要有两个不同的名称(这名称以字符串来存.为NIL的话系统每次会自己创建一个不同的名字，就是被次创建的都是新的EVENT)。
  711. 传回值：Eventhandle。
  712. }
  713. hInitFinished:=CreateEvent(nil,True,False,nil);
  714. hThreadTerminated:=CreateEvent(nil,True,False,nil);
  715. csProcessingDataObject:=TCriticalSection.Create;
  716. try
  717. WriteLog('TProcessorThread.Create::Resume',3);
  718. Resume;
  719. //阻塞,等待初始化完成
  720. WaitForSingleObject(hInitFinished,INFINITE);
  721. ifsInitError<>''then
  722. raiseException.Create(sInitError);
  723. finally
  724. CloseHandle(hInitFinished);
  725. end;
  726. WriteLog('TProcessorThread.Create::Finished',3);
  727. end;{TProcessorThread.Create}
  729. destructorTProcessorThread.Destroy;
  730. begin
  731. WriteLog('工作线程销毁',5);
  732. CloseHandle(hThreadTerminated);
  733. csProcessingDataObject.Free;
  734. inherited;
  735. end;{TProcessorThread.Destroy}
  737. functionTProcessorThread.AverageProcessingTime:DWORD;
  738. begin
  739. if(FCurStatein[tcsProcessing])then
  740. Result:=NewAverage(FAverageProcessing,GetTickCount-uProcessingStart)
  741. else
  742. Result:=FAverageProcessing
  743. end;{TProcessorThread.AverageProcessingTime}
  745. functionTProcessorThread.AverageWaitingTime:DWORD;
  746. begin
  747. if(FCurStatein[tcsWaiting,tcsCheckingDown])then
  748. Result:=NewAverage(FAverageWaitingTime,GetTickCount-uWaitingStart)
  749. else
  750. Result:=FAverageWaitingTime
  751. end;{TProcessorThread.AverageWaitingTime}
  753. procedureTProcessorThread.Execute;
  755. type
  756. THandleID=(hidTerminateThread,hidRequest,hidCheckPoolDown);
  757. var
  758. WaitedTime:Integer;
  759. Handles:array[THandleID]ofTHandle;
  761. begin
  762. WriteLog('工作线程进常运行',3);
  763. //当前状态：初始化
  764. FCurState:=tcsInitializing;
  765. try
  766. //执行外部事件
  767. FPool.DoThreadInitializing(Self);
  768. except
  769. one:Exceptiondo
  770. sInitError:=e.Message;
  771. end;
  773. //初始化完成，初始化Event绿灯
  774. SetEvent(hInitFinished);
  776. WriteLog('TProcessorThread.Execute::Initialized',3);
  778. //引用线程池的同步Event
  779. Handles[hidTerminateThread]:=hThreadTerminated;
  780. Handles[hidRequest]:=FPool.hSemRequestCount;
  781. Handles[hidCheckPoolDown]:=FPool.hTimCheckPoolDown;
  783. //时间戳，
  784. //todo:好像在线程中用GetTickCount;会不正常
  785. uWaitingStart:=GetTickCount;
  786. //任务置空
  787. FProcessingDataObject:=nil;
  789. //大巡环
  790. whilenotterminateddo
  791. begin
  792. //当前状态：等待
  793. FCurState:=tcsWaiting;
  794. //阻塞线程，使线程休眠
  795. caseWaitForMultipleObjects(Length(Handles),@Handles,False,INFINITE)-
  796. WAIT_OBJECT_0of
  798. WAIT_OBJECT_0+ord(hidTerminateThread):
  799. begin
  800. WriteLog('TProcessorThread.Execute::Terminateeventsignaled',5);
  801. //当前状态：正在终止线程
  802. FCurState:=tcsTerminating;
  803. //退出大巡环(结束线程)
  804. Break;
  805. end;
  807. WAIT_OBJECT_0+ord(hidRequest):
  808. begin
  809. WriteLog('TProcessorThread.Execute::Requestsemaphoresignaled',3);
  810. //等待的时间
  811. WaitedTime:=GetTickCount-uWaitingStart;
  812. //重新计算平均等待时间
  813. FAverageWaitingTime:=NewAverage(FAverageWaitingTime,WaitedTime);
  814. //当前状态：申请任务
  815. FCurState:=tcsGetting;
  816. //如果等待时间过短，则检查工作线程是否足够
  817. ifWaitedTime<5then
  818. FPool.CheckThreadsForGrow;
  819. //从线程池的任务队列中得到任务
  820. FPool.GetRequest(FProcessingDataObject);
  821. //开始处理的时间戳
  822. uProcessingStart:=GetTickCount;
  823. //当前状态：执行任务
  824. FCurState:=tcsProcessing;
  825. try
  826. {$IFNDEFNOLOGS}
  827. WriteLog('Processing:'+FProcessingDataObject.TextForLog,2);
  828. {$ENDIF}
  829. //执行任务
  830. FPool.DoProcessRequest(FProcessingDataObject,Self);
  831. except
  832. one:Exceptiondo
  833. WriteLog(
  834. 'OnProcessRequestfor'+FProcessingDataObject.TextForLog+
  835. #13#10'raiseException:'+e.Message,
  836. 8
  837. );
  838. end;
  840. //释放任务对象
  841. csProcessingDataObject.Enter;
  842. try
  843. FProcessingDataObject.Free;
  844. FProcessingDataObject:=nil;
  845. finally
  846. csProcessingDataObject.Leave;
  847. end;
  848. //重新计算
  849. FAverageProcessing:=NewAverage(FAverageProcessing,GetTickCount-
  850. uProcessingStart);
  851. //当前状态：执行任务完毕
  852. FCurState:=tcsProcessed;
  853. //执行线程外事件
  854. FPool.DoProcessed;
  856. uWaitingStart:=GetTickCount;
  857. end;
  858. WAIT_OBJECT_0+ord(hidCheckPoolDown):
  859. begin
  860. //!!!NevercalledunderWin9x
  861. WriteLog('TProcessorThread.Execute::CheckPoolDowntimersignaled',
  862. 4);
  863. //当前状态：线程池停机（检查并清除空闲线程和死线程）
  864. FCurState:=tcsCheckingDown;
  865. FPool.CheckPoolDown;
  866. end;
  867. end;
  868. end;
  869. FCurState:=tcsTerminating;
  871. FPool.DoThreadFinalizing(Self);
  872. end;{TProcessorThread.Execute}
  874. functionTProcessorThread.IamCurrentlyProcess(DataObj:TWorkItem):Boolean;
  875. begin
  876. csProcessingDataObject.Enter;
  877. try
  878. Result:=(FProcessingDataObject<>nil)and
  879. DataObj.IsTheSame(FProcessingDataObject);
  880. finally
  881. csProcessingDataObject.Leave;
  882. end;
  883. end;{TProcessorThread.IamCurrentlyProcess}
  885. functionTProcessorThread.InfoText:string;
  887. const
  888. ThreadStateNames:array[TThreadState]ofstring=
  889. (
  890. 'tcsInitializing',
  891. 'tcsWaiting',
  892. 'tcsGetting',
  893. 'tcsProcessing',
  894. 'tcsProcessed',
  895. 'tcsTerminating',
  896. 'tcsCheckingDown'
  897. );
  899. begin
  900. {$IFNDEFNOLOGS}
  901. Result:=Format(
  902. '%5d:%15s,AverageWaitingTime=%6d,AverageProcessingTime=%6d',
  903. [ThreadID,ThreadStateNames[FCurState],AverageWaitingTime,
  904. AverageProcessingTime]
  905. );
  906. caseFCurStateof
  907. tcsWaiting:
  908. Result:=Result+',WaitingTime='+IntToStr(GetTickCount-
  909. uWaitingStart);
  910. tcsProcessing:
  911. Result:=Result+',ProcessingTime='+IntToStr(GetTickCount-
  912. uProcessingStart);
  913. end;
  915. csProcessingDataObject.Enter;
  916. try
  917. ifFProcessingDataObject<>nilthen
  918. Result:=Result+''+FProcessingDataObject.TextForLog;
  919. finally
  920. csProcessingDataObject.Leave;
  921. end;
  922. {$ENDIF}
  923. end;{TProcessorThread.InfoText}
  925. functionTProcessorThread.IsDead:Boolean;
  926. begin
  927. Result:=
  928. Terminatedor
  929. (FPool.ThreadDeadTimeout>0)and(FCurState=tcsProcessing)and
  930. (GetTickCount-uProcessingStart>FPool.ThreadDeadTimeout);
  931. ifResultthen
  932. WriteLog('Threaddead',5);
  933. end;{TProcessorThread.IsDead}
  935. functionTProcessorThread.isFinished:Boolean;
  936. begin
  937. Result:=WaitForSingleObject(Handle,0)=WAIT_OBJECT_0;
  938. end;{TProcessorThread.isFinished}
  940. functionTProcessorThread.isIdle:Boolean;
  941. begin
  942. //如果线程状态是tcsWaiting,tcsCheckingDown
  943. //并且空间时间>100ms,
  944. //并且平均等候任务时间大于平均工作时间的50%
  945. //则视为空闲。
  946. Result:=
  947. (FCurStatein[tcsWaiting,tcsCheckingDown])and
  948. (AverageWaitingTime>100)and
  949. (AverageWaitingTime*2>AverageProcessingTime);
  950. end;{TProcessorThread.isIdle}
  952. functionTProcessorThread.NewAverage(OldAvg,NewVal:Integer):Integer;
  953. begin
  954. Result:=(OldAvg*2+NewVal)div3;
  955. end;{TProcessorThread.NewAverage}
  957. procedureTProcessorThread.Terminate;
  958. begin
  959. WriteLog('TProcessorThread.Terminate',5);
  960. inheritedTerminate;
  961. SetEvent(hThreadTerminated);
  962. end;{TProcessorThread.Terminate}
  964. procedureTProcessorThread.WriteLog(constStr:string;Level:Integer=0);
  965. begin
  966. {$IFNDEFNOLOGS}
  967. uThreadPool.WriteLog(Str,ThreadID,Level);
  968. {$ENDIF}
  969. end;{TProcessorThread.WriteLog}
  971. {
  972. *******************************TCriticalSection*******************************
  973. }
  975. constructorTCriticalSection.Create;
  976. begin
  977. InitializeCriticalSection(FSection);
  978. end;{TCriticalSection.Create}
  980. destructorTCriticalSection.Destroy;
  981. begin
  982. DeleteCriticalSection(FSection);
  983. end;{TCriticalSection.Destroy}
  985. procedureTCriticalSection.Enter;
  986. begin
  987. EnterCriticalSection(FSection);
  988. end;{TCriticalSection.Enter}
  990. procedureTCriticalSection.Leave;
  991. begin
  992. LeaveCriticalSection(FSection);
  993. end;{TCriticalSection.Leave}
  995. functionTCriticalSection.TryEnter:Boolean;
  996. begin
  997. Result:=TryEnterCriticalSection(FSection);
  998. end;{TCriticalSection.TryEnter}
  1000. procedureNoLogs(constStr:string;LogID:Integer=0;Level:Integer=0);
  1001. begin
  1002. end;
  1004. initialization
  1005. WriteLog:=NoLogs;
  1006. end.

http://blog.csdn.net/earbao/article/details/46515261

标签：#线程池#delphi#线程阻塞#try#string | 浏览：368 | 发布日期：

免责声明：文章转载自《delphi 自我删除和线程池（1000行代码，需要仔细研究）》仅用于学习参考。如对内容有疑问，请及时联系本站处理。

上篇【计算机组成原理】：存储系统学习(上)ExtJs6自定义scss解决actionColum中iconCls图标不能调样式的问题下篇

宿迁高防，2C2G15M，22元/月；香港BGP，2C5G5M，25元/月 雨云优惠码：MjYwNzM=

相关文章

基于jmeter-dubbo协议压测实践

背景 为了满足公司业务发展及性能要求，公司技术架构在很多业务接口调用设计中引用到了dubbo协议调用方式，对于以前HTTP feign调用的接口转为dubbo泛化调用后，接口性能如何？有何影响？需要进行压测评估。为解决公司RPC dubbo协议调用压测问题，需升级jmeter压测组件，扩展压测协议支持。   Dubbo泛化调用原理 在进行dubbo协议接...

.NET Core+QQ第三方授权登录

安装包 dotnet add package AspNet.Security.OAuth.QQ 接上文GitHub第三方授权登录 申请过程不介绍了，申请者资料,个人也是可以申请成功的。 这时候有二个参数就是clientid clientsecret APP ID：xxxx APP Key：xxxxxx 其中平台信息，这个申请审核通过后，不要修改，千万不...

从0来搭建超灵活的MVP商用框架&amp;lt;一&amp;gt;-------从MVC至MVP的转变、通用网络切换框架

其实早就想记录关于MVC、MVP、MVVM架构的演变细节了，所以接下来借此机会准备对于这块的东东详细进行一个梳理，就自己实际工作而言还是习惯用MVC传统的代码习惯，毕境习惯了它N多年了有点改不过来，而对于MVP的代码风格在目前的项目上基本上已经越来越普及了，而往往项目中MVC和MVP风格都并存在的，所以习惯MVP风格的代码风格也是当务之急的，最终会打造目前...

C# Dictionary通过value获取对应的key值[转发]

1：最直白的循环遍历方法，可以分为遍历key--value键值对以及所有的key两种表现形式 2：用Linq的方式去查询（当然了这里要添加对应的命名空间 using System.Linq）  如下为一个十分简单的代码示例： private void GetDicKeyByValue() { Dictionary...

UTL_FILE 的用法

UTL_FILE 是用来进行文件IO处理的专用包,使用这外包的注意事项如下: 1. 生成的文件好象只能放置在DATABASE所在的服务器路径中. 2. 生成的文件如何DOWNLOAD到本地来,还有待研究. Coding步骤: 1. 注册文件输出路径 Create directory path[例如: C:\AA]as 'pathname'; 此命令应由数...

C# 文件操作 全收录 追加、拷贝、删除、移动文件、创建目录、递归删除文件夹及文件....

本文收集了目前最为常用的C#经典操作文件的方法，具体内容如下：C#追加、拷贝、删除、移动文件、创建目录、递归删除文件夹及文件、指定文件夹下 面的所有内容copy到目标文件夹下面、指定文件夹下面的所有内容Detele、读取文本文件、获取文件列表、读取日志文件、写入日志文件、创建HTML 文件、CreateDirectory方法的使用C#追加文件Stream...

最新文章

随机推荐

思享工具箱导航