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

 

[delphi] view plain copy
 
  1. unit Unit4;  
  2.   
  3. interface  
  4.   
  5. uses  
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  7.   Dialogs, StdCtrls, ShellAPI, ShlObj, uThreadPool;  
  8.   
  9. type  
  10.   TForm4 = class(TForm)  
  11.     Button1: TButton;  
  12.     Button2: TButton;  
  13.     Button3: TButton;  
  14.     Button4: TButton;  
  15.     procedure Button1Click(Sender: TObject);  
  16.     procedure FormCreate(Sender: TObject);  
  17.     procedure Button2Click(Sender: TObject);  
  18.     procedure Button3Click(Sender: TObject);  
  19.     procedure Button4Click(Sender: TObject);  
  20.   private  
  21.     { Private declarations }  
  22.   public  
  23.     { Public declarations }  
  24.     procedure MyFun(Sender: TThreadsPool; WorkItem: TWorkItem;  
  25.       aThread: TProcessorThread);  
  26.   end;  
  27.   TRecvCommDataWorkItem=class(TWorkItem)  
  28.   
  29.   end;  
  30.   
  31. function selfdel: Boolean;  
  32. procedure deleteSelf;  
  33.   
  34. var  
  35.   Form4: TForm4;  
  36.   
  37. implementation  
  38.   
  39. {$R *.dfm}  
  40.   
  41. procedure TForm4.Button1Click(Sender: TObject);  
  42.   
  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, 'if exist "' + ParamStr(0) + '"' + ' goto try');  
  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.   if CreateProcess(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;  
  68.   
  69. procedure TForm4.Button2Click(Sender: TObject);  
  70. var  
  71.   f: TextFile;  
  72. begin  
  73.   AssignFile(f, '.delme.bat');  
  74.   Rewrite(f);  
  75.   Writeln(f, '@echo off');  
  76.   Writeln(f, ':loop');  
  77.   Writeln(f, 'del "' + Application.ExeName + '"');  
  78.   Writeln(f, 'if exist .file.exe goto loop');  
  79.   Writeln(f, 'del .delme.bat');  
  80.   CloseFile(f);  
  81.   winexec('.delme.bat', SW_HIDE);  
  82.   close;  
  83.   Application.Terminate;  
  84. end;  
  85.   
  86. procedure TForm4.Button3Click(Sender: TObject);  
  87. begin  
  88.   selfdel();  
  89. end;  
  90.   
  91. procedure TForm4.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方法中被调用)  
  101.   
  102.   // 使用线程池  
  103.   AWorkItem := TRecvCommDataWorkItem.Create;  
  104.   
  105.   FThreadPool.AddRequest(AWorkItem); // 向线程池分配一个任务 end;  
  106.   
  107.   FThreadPool.Free;  
  108. end;  
  109.   
  110. function selfdel: 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); // get file path names:  
  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 // set command shell parameters  
  124.     lstrcpy(szParams, '/c del ');  
  125.     lstrcat(szParams, szModule); // set struct members  
  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; // invoke command shell  
  134.     if (ShellExecuteEx(@sei)) then  
  135.     begin // suppress command shell process until program exits  
  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.       // notify explorer shell of deletion  
  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;  
  150.   
  151. procedure TForm4.FormCreate(Sender: TObject);  
  152. begin  
  153.   // Button1Click(Sender);  
  154.   // Button2Click(Sender);  
  155.   // selfdel();  
  156.   // Application.Terminate;  
  157.   // deleteSelf;  
  158. end;  
  159.   
  160. procedure TForm4.MyFun(Sender: TThreadsPool; WorkItem: TWorkItem;  
  161.   aThread: TProcessorThread);  
  162. var  
  163.   i: Integer;  
  164. begin  
  165.   for i := 0 to 500 do  
  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;  
  174.   
  175. // http://www.52delphi.com/List.asp?ID=364&Page=3  
  176. procedure deleteSelf;  
  177. var  
  178.   hModule: THandle;  
  179.   szModuleName: array [0 .. MAX_PATH] of char;  
  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 ($80000000 and GetVersion()) <> 0 then // Win95, 98, Me  
  193.   asm lea eax, szModuleName  
  194.   push ExitCode  
  195.   push 0  
  196.   push eax  
  197.   push pExitProcess  
  198.   push hModule  
  199.   push pdeleteFile  
  200.   push pFreeLibrary  
  201.   ret  
  202.    end  
  203.   else  
  204.   begin  
  205.     CloseHandle(THandle(4));  
  206.       asm lea eax, szModuleName  
  207.       push ExitCode  
  208.       push 0  
  209.       push eax  
  210.       push pExitProcess  
  211.       push hModule  
  212.       push pdeleteFile  
  213.       push pUnmapViewOfFile  
  214.        ret end  
  215.   end  
  216. end;  
  217.   
  218. end.  
[delphi] view plain copy
 
  1. unit uThreadPool;  
  2.   
  3. {   aPool.AddRequest(TMyRequest.Create(RequestParam1, RequestParam2, ...)); }  
  4.   
  5. interface  
  6. uses  
  7.   Windows,  
  8.   Classes;  
  9.   
  10. // 是否记录日志  
  11. // {$DEFINE NOLOGS}  
  12.   
  13. type  
  14.   TCriticalSection = class(TObject)  
  15.   protected  
  16.     FSection: TRTLCriticalSection;  
  17.   public  
  18.     constructor Create;  
  19.     destructor Destroy; override;  
  20.     // 进入临界区  
  21.     procedure Enter;  
  22.     // 离开临界区  
  23.     procedure Leave;  
  24.     // 尝试进入  
  25.     function TryEnter: Boolean;  
  26.   end;  
  27.   
  28. type  
  29.   // 储存请求数据的基本类  
  30.   TWorkItem = class(TObject)  
  31.   public  
  32.     // 是否有重复任务  
  33.     function IsTheSame(DataObj: TWorkItem): Boolean; virtual;  
  34.     // 如果 NOLOGS 被定义，则禁用。  
  35.     function TextForLog: string; virtual;  
  36.   end;  
  37.   
  38. type  
  39.   TThreadsPool = class;  
  40.   
  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.     procedure WriteLog(const Str: 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.     function AverageProcessingTime: DWORD;  
  73.     // 计算平均等待时间  
  74.     function AverageWaitingTime: DWORD;  
  75.     procedure Execute; override;  
  76.     function IamCurrentlyProcess(DataObj: TWorkItem): Boolean;  
  77.     // 转换枚举类型的线程状态为字串类型  
  78.     function InfoText: string;  
  79.     // 线程是否长时间处理同一个请求？（已死掉？）  
  80.     function IsDead: Boolean;  
  81.     // 线程是否已完成当成任务  
  82.     function isFinished: Boolean;  
  83.     // 线程是否处于空闲状态  
  84.     function isIdle: Boolean;  
  85.     // 平均值校正计算。  
  86.     function NewAverage(OldAvg, NewVal: Integer): Integer;  
  87.   public  
  88.     Tag: Integer;  
  89.     constructor Create(APool: TThreadsPool);  
  90.     destructor Destroy; override;  
  91.     procedure Terminate;  
  92.   end;  
  93.   
  94.   // 线程初始化时触发的事件  
  95.   TProcessorThreadInitializing = procedure(Sender: TThreadsPool; aThread:  
  96.     TProcessorThread) of object;  
  97.   // 线程结束时触发的事件  
  98.   TProcessorThreadFinalizing = procedure(Sender: TThreadsPool; aThread:  
  99.     TProcessorThread) of object;  
  100.   // 线程处理请求时触发的事件  
  101.   TProcessRequest = procedure(Sender: TThreadsPool; WorkItem: TWorkItem;  
  102.     aThread: TProcessorThread) of object;  
  103.   TEmptyKind = (  
  104.     ekQueueEmpty, //任务被取空后  
  105.     ekProcessingFinished // 最后一个任务处理完毕后  
  106.     );  
  107.   // 任务队列空时触发的事件  
  108.   TQueueEmpty = procedure(Sender: TThreadsPool; EmptyKind: TEmptyKind) of  
  109.     object;  
  110.   
  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.     function PoolAverageWaitingTime: Integer;  
  132.     procedure WriteLog(const Str: string; Level: Integer = 0);  
  133.   protected  
  134.     FLastGetPoint: Integer;  
  135.     // Semaphore， 统计任务队列  
  136.     hSemRequestCount: THandle;  
  137.     // Waitable timer. 每30触发一次的时间量同步  
  138.     hTimCheckPoolDown: THandle;  
  139.     // 线程池停机（检查并清除空闲线程和死线程）  
  140.     procedure CheckPoolDown;  
  141.     // 清除死线程，并补充不足的工作线程  
  142.     procedure CheckThreadsForGrow;  
  143.     procedure DoProcessed;  
  144.     procedure DoProcessRequest(aDataObj: TWorkItem; aThread: TProcessorThread);  
  145.       virtual;  
  146.     procedure DoQueueEmpty(EmptyKind: TEmptyKind); virtual;  
  147.     procedure DoThreadFinalizing(aThread: TProcessorThread); virtual;  
  148.     // 执行事件  
  149.     procedure DoThreadInitializing(aThread: TProcessorThread); virtual;  
  150.     // 释放 FThreadsKilling 列表中的线程  
  151.     procedure FreeFinishedThreads;  
  152.     // 申请任务  
  153.     procedure GetRequest(out Request: TWorkItem);  
  154.     // 清除死线程  
  155.     procedure KillDeadThreads;  
  156.   public  
  157.     constructor Create(AOwner: TComponent); override;  
  158.     destructor Destroy; override;  
  159.     // 就进行任务是否重复的检查, 检查发现重复就返回 False  
  160.     function AddRequest(aDataObject: TWorkItem; CheckForDoubles: Boolean =  
  161.       False): Boolean; overload;  
  162.     // 转换枚举类型的线程状态为字串类型  
  163.     function InfoText: string;  
  164.   published  
  165.     // 线程处理任务时触发的事件  
  166.     property OnProcessRequest: TProcessRequest read FProcessRequest write  
  167.       FProcessRequest;  
  168.     // 任务列表为空时解发的事件  
  169.     property OnQueueEmpty: TQueueEmpty read FQueueEmpty write FQueueEmpty;  
  170.     // 线程结束时触发的事件  
  171.     property OnThreadFinalizing: TProcessorThreadFinalizing read  
  172.       FThreadFinalizing write FThreadFinalizing;  
  173.     // 线程初始化时触发的事件  
  174.     property OnThreadInitializing: TProcessorThreadInitializing read  
  175.       FThreadInitializing write FThreadInitializing;  
  176.     // 线程超时值（毫秒), 如果处理超时，将视为死线程  
  177.     property ThreadDeadTimeout: DWORD read FThreadDeadTimeout write  
  178.       FThreadDeadTimeout default 0;  
  179.     // 最大线程数  
  180.     property ThreadsMax: Integer read FThreadsMax write FThreadsMax default 1;  
  181.     // 最小线程数  
  182.     property ThreadsMin: Integer read FThreadsMin write FThreadsMin default 0;  
  183.   end;  
  184.   
  185. type  
  186.   //日志记志函数  
  187.   TLogWriteProc = procedure(  
  188.     const Str: string; //日志  
  189.     LogID: Integer = 0;  
  190.     Level: Integer = 0 //Level = 0 - 跟踪信息, 10 - 致命错误  
  191.     );  
  192.   
  193. var  
  194.   WriteLog: TLogWriteProc; // 如果存在实例就写日志  
  195.   
  196. implementation  
  197. uses  
  198.   SysUtils;  
  199.   
  200. // 储存请求数据的基本类  
  201. { 
  202. ********************************** TWorkItem *********************************** 
  203. }  
  204.   
  205. function TWorkItem.IsTheSame(DataObj: TWorkItem): Boolean;  
  206. begin  
  207.   Result := False;  
  208. end; { TWorkItem.IsTheSame }  
  209.   
  210. function TWorkItem.TextForLog: string;  
  211. begin  
  212.   Result := 'Request';  
  213. end; { TWorkItem.TextForLog }  
  214.   
  215. { 
  216. ********************************* TThreadsPool ********************************* 
  217. }  
  218.   
  219. constructor TThreadsPool.Create(AOwner: TComponent);  
  220. var  
  221.   DueTo: Int64;  
  222. begin  
  223. {$IFNDEF NOLOGS}  
  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);  
  238.   
  239.   DueTo := -1;  
  240.   //可等待的定时器（只用于Window NT4或更高）  
  241.   hTimCheckPoolDown := CreateWaitableTimer(nil, False, nil);  
  242.   
  243.   if hTimCheckPoolDown = 0 then // Win9x不支持  
  244.     // In Win9x number of thread will be never decrised  
  245.     hTimCheckPoolDown := CreateEvent(nil, False, False, nil)  
  246.   else  
  247.     SetWaitableTimer(hTimCheckPoolDown, DueTo, 30000, nil, nil, False);  
  248. end; { TThreadsPool.Create }  
  249.   
  250. destructor TThreadsPool.Destroy;  
  251. var  
  252.   n, i: Integer;  
  253.   Handles: array of THandle;  
  254. begin  
  255. {$IFNDEF NOLOGS}  
  256.   WriteLog('线程池销毁', 5);  
  257. {$ENDIF}  
  258.   csThreadManagment.Enter;  
  259.   
  260.   SetLength(Handles, FThreads.Count);  
  261.   n := 0;  
  262.   for i := 0 to FThreads.Count - 1 do  
  263.     if FThreads[i] <> nil then  
  264.     begin  
  265.       Handles[n] := TProcessorThread(FThreads[i]).Handle;  
  266.       TProcessorThread(FThreads[i]).Terminate;  
  267.       Inc(n);  
  268.     end;  
  269.   
  270.   csThreadManagment.Leave;  // lixiaoyu 添加于 2009.1.6，如没有此行代码无法成功释放正在执行中的工作者线程，死锁。  
  271.   
  272.   WaitForMultipleObjects(n, @Handles[0], True, 30000);  // 等待工作者线程执行终止  lixiaoyu 注释于 2009.1.6  
  273.   
  274.   csThreadManagment.Enter;  // lixiaoyu 添加于 2009.1.6 再次进入锁定，并释放资源  
  275.   for i := 0 to FThreads.Count - 1 do  
  276.     TProcessorThread(FThreads[i]).Free;  
  277.   FThreads.Free;  
  278.   FThreadsKilling.Free;  
  279.   csThreadManagment.Free;  
  280.   
  281.   csQueueManagment.Enter;  
  282.   for i := FQueue.Count - 1 downto 0 do  
  283.     TObject(FQueue[i]).Free;  
  284.   FQueue.Free;  
  285.   csQueueManagment.Free;  
  286.   
  287.   CloseHandle(hSemRequestCount);  
  288.   CloseHandle(hTimCheckPoolDown);  
  289.   inherited;  
  290. end; { TThreadsPool.Destroy }  
  291.   
  292. function TThreadsPool.AddRequest(aDataObject: TWorkItem; CheckForDoubles:  
  293.   Boolean = False): Boolean;  
  294. var  
  295.   i: Integer;  
  296. begin  
  297. {$IFNDEF NOLOGS}  
  298.   WriteLog('AddRequest(' + aDataObject.TextForLog + ')', 2);  
  299. {$ENDIF}  
  300.   Result := False;  
  301.   csQueueManagment.Enter;  
  302.   try  
  303.     // 如果 CheckForDoubles = TRUE  
  304.     // 则进行任务是否重复的检查  
  305.     if CheckForDoubles then  
  306.       for i := 0 to FQueue.Count - 1 do  
  307.         if (FQueue[i] <> nil)  
  308.           and aDataObject.IsTheSame(TWorkItem(FQueue[i])) then  
  309.           Exit; // 发现有相同的任务  
  310.   
  311.     csThreadManagment.Enter;  
  312.     try  
  313.       // 清除死线程，并补充不足的工作线程  
  314.       CheckThreadsForGrow;  
  315.   
  316.       // 如果 CheckForDoubles = TRUE  
  317.       // 则检查是否有相同的任务正在处理中  
  318.       if CheckForDoubles then  
  319.         for i := 0 to FThreads.Count - 1 do  
  320.           if TProcessorThread(FThreads[i]).IamCurrentlyProcess(aDataObject) then  
  321.             Exit; // 发现有相同的任务  
  322.   
  323.     finally  
  324.       csThreadManagment.Leave;  
  325.     end;  
  326.   
  327.     //将任务加入队列  
  328.     FQueue.Add(aDataObject);  
  329.   
  330.     //释放一个同步信号量  
  331.     ReleaseSemaphore(hSemRequestCount, 1, nil);  
  332. {$IFNDEF NOLOGS}  
  333.     WriteLog('释放一个同步信号量)', 1);  
  334. {$ENDIF}  
  335.     Result := True;  
  336.   finally  
  337.     csQueueManagment.Leave;  
  338.   end;  
  339. {$IFNDEF NOLOGS}  
  340.   //调试信息  
  341.   WriteLog('增加一个任务(' + aDataObject.TextForLog + ')', 1);  
  342. {$ENDIF}  
  343. end; { TThreadsPool.AddRequest }  
  344.   
  345. { 
  346. 函 数 名：TThreadsPool.CheckPoolDown 
  347. 功能描述：线程池停机（检查并清除空闲线程和死线程） 
  348. 输入参数：无 
  349. 返 回 值: 无 
  350. 创建日期：2006.10.22 11:31 
  351. 修改日期：2006. 
  352. 作    者：Kook 
  353. 附加说明： 
  354. }  
  355.   
  356. procedure TThreadsPool.CheckPoolDown;  
  357. var  
  358.   i: Integer;  
  359. begin  
  360. {$IFNDEF NOLOGS}  
  361.   WriteLog('TThreadsPool.CheckPoolDown', 1);  
  362. {$ENDIF}  
  363.   csThreadManagment.Enter;  
  364.   try  
  365. {$IFNDEF NOLOGS}  
  366.     WriteLog(InfoText, 2);  
  367. {$ENDIF}  
  368.     // 清除死线程  
  369.     KillDeadThreads;  
  370.     // 释放 FThreadsKilling 列表中的线程  
  371.     FreeFinishedThreads;  
  372.   
  373.     // 如果线程空闲，就终止它  
  374.     for i := FThreads.Count - 1 downto FThreadsMin do  
  375.       if TProcessorThread(FThreads[i]).isIdle then  
  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 }  
  390.   
  391. { 
  392. 函 数 名：TThreadsPool.CheckThreadsForGrow 
  393. 功能描述：清除死线程，并补充不足的工作线程 
  394. 输入参数：无 
  395. 返 回 值: 无 
  396. 创建日期：2006.10.22 11:31 
  397. 修改日期：2006. 
  398. 作    者：Kook 
  399. 附加说明： 
  400. }  
  401.   
  402. procedure TThreadsPool.CheckThreadsForGrow;  
  403. var  
  404.   AvgWait: Integer;  
  405.   i: Integer;  
  406. begin  
  407.   { 
  408.     New thread created if: 
  409.     新建线程的条件： 
  410.       1. 工作线程数小于最小线程数 
  411.       2. 工作线程数小于最大线程数 and 线程池平均等待时间 < 100ms(系统忙) 
  412.       3. 任务大于工作线程数的4倍 
  413.   }  
  414.   
  415.   csThreadManagment.Enter;  
  416.   try  
  417.     KillDeadThreads;  
  418.     if FThreads.Count < FThreadsMin then  
  419.     begin  
  420. {$IFNDEF NOLOGS}  
  421.       WriteLog('工作线程数小于最小线程数', 4);  
  422. {$ENDIF}  
  423.       for i := FThreads.Count to FThreadsMin - 1 do  
  424.       try  
  425.         FThreads.Add(TProcessorThread.Create(Self));  
  426.       except  
  427.         on e: Exception do  
  428.   
  429.           WriteLog(  
  430.             'TProcessorThread.Create raise: ' + e.ClassName + #13#10#9'Message: '  
  431.             + e.Message,  
  432.             9  
  433.             );  
  434.       end  
  435.     end  
  436.     else if FThreads.Count < FThreadsMax then  
  437.     begin  
  438. {$IFNDEF NOLOGS}  
  439.       WriteLog('工作线程数小于最大线程数 and 线程池平均等待时间 < 100ms', 3);  
  440. {$ENDIF}  
  441.       AvgWait := PoolAverageWaitingTime;  
  442. {$IFNDEF NOLOGS}  
  443.       WriteLog(Format(  
  444.         'FThreads.Count (%d)<FThreadsMax(%d), AvgWait=%d',  
  445.         [FThreads.Count, FThreadsMax, AvgWait]),  
  446.         4  
  447.         );  
  448. {$ENDIF}  
  449.   
  450.       if AvgWait < 100 then  
  451.       try  
  452.         FThreads.Add(TProcessorThread.Create(Self));  
  453.       except  
  454.         on e: Exception do  
  455.           WriteLog(  
  456.             'TProcessorThread.Create raise: ' + 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 }  
  466.   
  467. procedure TThreadsPool.DoProcessed;  
  468. var  
  469.   i: Integer;  
  470. begin  
  471.   if (FLastGetPoint < FQueue.Count) then  
  472.     Exit;  
  473.   csThreadManagment.Enter;  
  474.   try  
  475.     for i := 0 to FThreads.Count - 1 do  
  476.       if TProcessorThread(FThreads[i]).FCurState in [tcsProcessing] then  
  477.         Exit;  
  478.   finally  
  479.     csThreadManagment.Leave;  
  480.   end;  
  481.   DoQueueEmpty(ekProcessingFinished);  
  482. end; { TThreadsPool.DoProcessed }  
  483.   
  484. procedure TThreadsPool.DoProcessRequest(aDataObj: TWorkItem; aThread:  
  485.   TProcessorThread);  
  486. begin  
  487.   if Assigned(FProcessRequest) then  
  488.     FProcessRequest(Self, aDataObj, aThread);  
  489. end; { TThreadsPool.DoProcessRequest }  
  490.   
  491. procedure TThreadsPool.DoQueueEmpty(EmptyKind: TEmptyKind);  
  492. begin  
  493.   if Assigned(FQueueEmpty) then  
  494.     FQueueEmpty(Self, EmptyKind);  
  495. end; { TThreadsPool.DoQueueEmpty }  
  496.   
  497. procedure TThreadsPool.DoThreadFinalizing(aThread: TProcessorThread);  
  498. begin  
  499.   if Assigned(FThreadFinalizing) then  
  500.     FThreadFinalizing(Self, aThread);  
  501. end; { TThreadsPool.DoThreadFinalizing }  
  502.   
  503. procedure TThreadsPool.DoThreadInitializing(aThread: TProcessorThread);  
  504. begin  
  505.   if Assigned(FThreadInitializing) then  
  506.     FThreadInitializing(Self, aThread);  
  507. end; { TThreadsPool.DoThreadInitializing }  
  508.   
  509. { 
  510. 函 数 名：TThreadsPool.FreeFinishedThreads 
  511. 功能描述：释放 FThreadsKilling 列表中的线程 
  512. 输入参数：无 
  513. 返 回 值: 无 
  514. 创建日期：2006.10.22 11:34 
  515. 修改日期：2006. 
  516. 作    者：Kook 
  517. 附加说明： 
  518. }  
  519.   
  520. procedure TThreadsPool.FreeFinishedThreads;  
  521. var  
  522.   i: Integer;  
  523. begin  
  524.   if csThreadManagment.TryEnter then  
  525.   try  
  526.     for i := FThreadsKilling.Count - 1 downto 0 do  
  527.       if TProcessorThread(FThreadsKilling[i]).isFinished then  
  528.       begin  
  529.         TProcessorThread(FThreadsKilling[i]).Free;  
  530.         FThreadsKilling.Delete(i);  
  531.       end;  
  532.   finally  
  533.     csThreadManagment.Leave  
  534.   end;  
  535. end; { TThreadsPool.FreeFinishedThreads }  
  536.   
  537. { 
  538. 函 数 名：TThreadsPool.GetRequest 
  539. 功能描述：申请任务 
  540. 输入参数：out Request: TRequestDataObject 
  541. 返 回 值: 无 
  542. 创建日期：2006.10.22 11:34 
  543. 修改日期：2006. 
  544. 作    者：Kook 
  545. 附加说明： 
  546. }  
  547.   
  548. procedure TThreadsPool.GetRequest(out Request: TWorkItem);  
  549. begin  
  550. {$IFNDEF NOLOGS}  
  551.   WriteLog('申请任务', 2);  
  552. {$ENDIF}  
  553.   csQueueManagment.Enter;  
  554.   try  
  555.     //跳过空的队列元素  
  556.     while (FLastGetPoint < FQueue.Count) and (FQueue[FLastGetPoint] = nil) do  
  557.       Inc(FLastGetPoint);  
  558.   
  559.     Assert(FLastGetPoint < FQueue.Count);  
  560.     //压缩队列，清除空元素  
  561.     if (FQueue.Count > 127) and (FLastGetPoint >= (3 * FQueue.Count) div 4) then  
  562.     begin  
  563. {$IFNDEF NOLOGS}  
  564.       WriteLog('FQueue.Pack', 1);  
  565. {$ENDIF}  
  566.       FQueue.Pack;  
  567.       FLastGetPoint := 0;  
  568.     end;  
  569.   
  570.     Request := TWorkItem(FQueue[FLastGetPoint]);  
  571.     FQueue[FLastGetPoint] := nil;  
  572.     inc(FLastGetPoint);  
  573.     if (FLastGetPoint = FQueue.Count) then //如果队列中无任务  
  574.     begin  
  575.   
  576.       DoQueueEmpty(ekQueueEmpty);  
  577.       FQueue.Clear;  
  578.       FLastGetPoint := 0;  
  579.     end;  
  580.   finally  
  581.     csQueueManagment.Leave;  
  582.   end;  
  583. end; { TThreadsPool.GetRequest }  
  584.   
  585. function TThreadsPool.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]).isFinished then  
  598.   //      FreeFinishedThreads;  
  599.   //  
  600.   //    Result := Format(  
  601.   //      'Pool thread: Min=%d, Max=%d, WorkingThreadsCount=%d, TerminatedThreadCount=%d, QueueLength=%d'#13#10,  
  602.   //      [ThreadsMin, ThreadsMax, FThreads.Count, FThreadsKilling.Count,  
  603.   //      FQueue.Count]  
  604.   //        );  
  605.   //    if FThreads.Count > 0 then  
  606.   //      Result := Result + 'Working threads:'#13#10;  
  607.   //    for i := 0 to FThreads.Count - 1 do  
  608.   //      Result := Result + TProcessorThread(FThreads[i]).InfoText + #13#10;  
  609.   //    if FThreadsKilling.Count > 0 then  
  610.   //      Result := Result + 'Terminated threads:'#13#10;  
  611.   //    for i := 0 to FThreadsKilling.Count - 1 do  
  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 }  
  620.   
  621. { 
  622. 函 数 名：TThreadsPool.KillDeadThreads 
  623. 功能描述：清除死线程 
  624. 输入参数：无 
  625. 返 回 值: 无 
  626. 创建日期：2006.10.22 11:32 
  627. 修改日期：2006. 
  628. 作    者：Kook 
  629. 附加说明： 
  630. }  
  631.   
  632. procedure TThreadsPool.KillDeadThreads;  
  633. var  
  634.   i: Integer;  
  635. begin  
  636.   // Check for dead threads  
  637.   if csThreadManagment.TryEnter then  
  638.   try  
  639.     for i := 0 to FThreads.Count - 1 do  
  640.       if TProcessorThread(FThreads[i]).IsDead then  
  641.       begin  
  642.         // Dead thread moverd to other list.  
  643.         // New thread created to replace dead one  
  644.         TProcessorThread(FThreads[i]).Terminate;  
  645.         FThreadsKilling.Add(FThreads[i]);  
  646.         try  
  647.           FThreads[i] := TProcessorThread.Create(Self);  
  648.         except  
  649.           on e: Exception do  
  650.           begin  
  651.             FThreads[i] := nil;  
  652. {$IFNDEF NOLOGS}  
  653.             WriteLog(  
  654.               'TProcessorThread.Create raise: ' + 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 }  
  666.   
  667. function TThreadsPool.PoolAverageWaitingTime: Integer;  
  668. var  
  669.   i: Integer;  
  670. begin  
  671.   Result := 0;  
  672.   if FThreads.Count > 0 then  
  673.   begin  
  674.     for i := 0 to FThreads.Count - 1 do  
  675.       Inc(result, TProcessorThread(FThreads[i]).AverageWaitingTime);  
  676.     Result := Result div FThreads.Count  
  677.   end  
  678.   else  
  679.     Result := 1;  
  680. end; { TThreadsPool.PoolAverageWaitingTime }  
  681.   
  682. procedure TThreadsPool.WriteLog(const Str: string; Level: Integer = 0);  
  683. begin  
  684. {$IFNDEF NOLOGS}  
  685.   uThreadPool.WriteLog(Str, 0, Level);  
  686. {$ENDIF}  
  687. end; { TThreadsPool.WriteLog }  
  688.   
  689. // 工作线程仅用于线程池内， 不要直接创建并调用它。  
  690. { 
  691. ******************************* TProcessorThread ******************************* 
  692. }  
  693.   
  694. constructor TProcessorThread.Create(APool: TThreadsPool);  
  695. begin  
  696.   WriteLog('创建工作线程', 5);  
  697.   inherited Create(True);  
  698.   FPool := aPool;  
  699.   
  700.   FAverageWaitingTime := 1000;  
  701.   FAverageProcessing := 3000;  
  702.   
  703.   sInitError := '';  
  704.   { 
  705.   各参数的意义如下： 
  706.   　 
  707.    参数一：填上 nil 即可。 
  708.    参数二：是否采用手动调整灯号。 
  709.    参数三：灯号的起始状态，False 表示红灯。 
  710.    参数四：Event 名称, 对象名称相同的话，会指向同一个对象，所以想要有两个Event对象，便要有两个不同的名称(这名称以字符串来存.为NIL的话系统每次会自己创建一个不同的名字，就是被次创建的都是新的EVENT)。 
  711.    传回值：Event handle。 
  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.     if sInitError <> '' then  
  722.       raise Exception.Create(sInitError);  
  723.   finally  
  724.     CloseHandle(hInitFinished);  
  725.   end;  
  726.   WriteLog('TProcessorThread.Create::Finished', 3);  
  727. end; { TProcessorThread.Create }  
  728.   
  729. destructor TProcessorThread.Destroy;  
  730. begin  
  731.   WriteLog('工作线程销毁', 5);  
  732.   CloseHandle(hThreadTerminated);  
  733.   csProcessingDataObject.Free;  
  734.   inherited;  
  735. end; { TProcessorThread.Destroy }  
  736.   
  737. function TProcessorThread.AverageProcessingTime: DWORD;  
  738. begin  
  739.   if (FCurState in [tcsProcessing]) then  
  740.     Result := NewAverage(FAverageProcessing, GetTickCount - uProcessingStart)  
  741.   else  
  742.     Result := FAverageProcessing  
  743. end; { TProcessorThread.AverageProcessingTime }  
  744.   
  745. function TProcessorThread.AverageWaitingTime: DWORD;  
  746. begin  
  747.   if (FCurState in [tcsWaiting, tcsCheckingDown]) then  
  748.     Result := NewAverage(FAverageWaitingTime, GetTickCount - uWaitingStart)  
  749.   else  
  750.     Result := FAverageWaitingTime  
  751. end; { TProcessorThread.AverageWaitingTime }  
  752.   
  753. procedure TProcessorThread.Execute;  
  754.   
  755. type  
  756.   THandleID = (hidTerminateThread, hidRequest, hidCheckPoolDown);  
  757. var  
  758.   WaitedTime: Integer;  
  759.   Handles: array[THandleID] of THandle;  
  760.   
  761. begin  
  762.   WriteLog('工作线程进常运行', 3);  
  763.   //当前状态：初始化  
  764.   FCurState := tcsInitializing;  
  765.   try  
  766.     //执行外部事件  
  767.     FPool.DoThreadInitializing(Self);  
  768.   except  
  769.     on e: Exception do  
  770.       sInitError := e.Message;  
  771.   end;  
  772.   
  773.   //初始化完成，初始化Event绿灯  
  774.   SetEvent(hInitFinished);  
  775.   
  776.   WriteLog('TProcessorThread.Execute::Initialized', 3);  
  777.   
  778.   //引用线程池的同步 Event  
  779.   Handles[hidTerminateThread] := hThreadTerminated;  
  780.   Handles[hidRequest] := FPool.hSemRequestCount;  
  781.   Handles[hidCheckPoolDown] := FPool.hTimCheckPoolDown;  
  782.   
  783.   //时间戳，  
  784.   //todo: 好像在线程中用 GetTickCount; 会不正常  
  785.   uWaitingStart := GetTickCount;  
  786.   //任务置空  
  787.   FProcessingDataObject := nil;  
  788.   
  789.   //大巡环  
  790.   while not terminated do  
  791.   begin  
  792.     //当前状态：等待  
  793.     FCurState := tcsWaiting;  
  794.     //阻塞线程，使线程休眠  
  795.     case WaitForMultipleObjects(Length(Handles), @Handles, False, INFINITE) -  
  796.       WAIT_OBJECT_0 of  
  797.   
  798.       WAIT_OBJECT_0 + ord(hidTerminateThread):  
  799.         begin  
  800.           WriteLog('TProcessorThread.Execute:: Terminate event signaled ', 5);  
  801.           //当前状态：正在终止线程  
  802.           FCurState := tcsTerminating;  
  803.           //退出大巡环(结束线程)  
  804.           Break;  
  805.         end;  
  806.   
  807.       WAIT_OBJECT_0 + ord(hidRequest):  
  808.         begin  
  809.           WriteLog('TProcessorThread.Execute:: Request semaphore signaled ', 3);  
  810.           //等待的时间  
  811.           WaitedTime := GetTickCount - uWaitingStart;  
  812.           //重新计算平均等待时间  
  813.           FAverageWaitingTime := NewAverage(FAverageWaitingTime, WaitedTime);  
  814.           //当前状态：申请任务  
  815.           FCurState := tcsGetting;  
  816.           //如果等待时间过短，则检查工作线程是否足够  
  817.           if WaitedTime < 5 then  
  818.             FPool.CheckThreadsForGrow;  
  819.           //从线程池的任务队列中得到任务  
  820.           FPool.GetRequest(FProcessingDataObject);  
  821.           //开始处理的时间戳  
  822.           uProcessingStart := GetTickCount;  
  823.           //当前状态：执行任务  
  824.           FCurState := tcsProcessing;  
  825.           try  
  826. {$IFNDEF NOLOGS}  
  827.             WriteLog('Processing: ' + FProcessingDataObject.TextForLog, 2);  
  828. {$ENDIF}  
  829.             //执行任务  
  830.             FPool.DoProcessRequest(FProcessingDataObject, Self);  
  831.           except  
  832.             on e: Exception do  
  833.               WriteLog(  
  834.                 'OnProcessRequest for ' + FProcessingDataObject.TextForLog +  
  835.                 #13#10'raise Exception: ' + e.Message,  
  836.                 8  
  837.                 );  
  838.           end;  
  839.   
  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;  
  855.   
  856.           uWaitingStart := GetTickCount;  
  857.         end;  
  858.       WAIT_OBJECT_0 + ord(hidCheckPoolDown):  
  859.         begin  
  860.           // !!! Never called under Win9x  
  861.           WriteLog('TProcessorThread.Execute:: CheckPoolDown timer signaled ',  
  862.             4);  
  863.           //当前状态：线程池停机（检查并清除空闲线程和死线程）  
  864.           FCurState := tcsCheckingDown;  
  865.           FPool.CheckPoolDown;  
  866.         end;  
  867.     end;  
  868.   end;  
  869.   FCurState := tcsTerminating;  
  870.   
  871.   FPool.DoThreadFinalizing(Self);  
  872. end; { TProcessorThread.Execute }  
  873.   
  874. function TProcessorThread.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 }  
  884.   
  885. function TProcessorThread.InfoText: string;  
  886.   
  887. const  
  888.   ThreadStateNames: array[TThreadState] of string =  
  889.   (  
  890.     'tcsInitializing',  
  891.     'tcsWaiting',  
  892.     'tcsGetting',  
  893.     'tcsProcessing',  
  894.     'tcsProcessed',  
  895.     'tcsTerminating',  
  896.     'tcsCheckingDown'  
  897.     );  
  898.   
  899. begin  
  900. {$IFNDEF NOLOGS}  
  901.   Result := Format(  
  902.     '%5d: %15s, AverageWaitingTime=%6d, AverageProcessingTime=%6d',  
  903.     [ThreadID, ThreadStateNames[FCurState], AverageWaitingTime,  
  904.     AverageProcessingTime]  
  905.       );  
  906.   case FCurState of  
  907.     tcsWaiting:  
  908.       Result := Result + ', WaitingTime=' + IntToStr(GetTickCount -  
  909.         uWaitingStart);  
  910.     tcsProcessing:  
  911.       Result := Result + ', ProcessingTime=' + IntToStr(GetTickCount -  
  912.         uProcessingStart);  
  913.   end;  
  914.   
  915.   csProcessingDataObject.Enter;  
  916.   try  
  917.     if FProcessingDataObject <> nil then  
  918.       Result := Result + ' ' + FProcessingDataObject.TextForLog;  
  919.   finally  
  920.     csProcessingDataObject.Leave;  
  921.   end;  
  922. {$ENDIF}  
  923. end; { TProcessorThread.InfoText }  
  924.   
  925. function TProcessorThread.IsDead: Boolean;  
  926. begin  
  927.   Result :=  
  928.     Terminated or  
  929.     (FPool.ThreadDeadTimeout > 0) and (FCurState = tcsProcessing) and  
  930.     (GetTickCount - uProcessingStart > FPool.ThreadDeadTimeout);  
  931.   if Result then  
  932.     WriteLog('Thread dead', 5);  
  933. end; { TProcessorThread.IsDead }  
  934.   
  935. function TProcessorThread.isFinished: Boolean;  
  936. begin  
  937.   Result := WaitForSingleObject(Handle, 0) = WAIT_OBJECT_0;  
  938. end; { TProcessorThread.isFinished }  
  939.   
  940. function TProcessorThread.isIdle: Boolean;  
  941. begin  
  942.   // 如果线程状态是 tcsWaiting, tcsCheckingDown  
  943.   // 并且 空间时间 > 100ms,  
  944.   // 并且 平均等候任务时间大于平均工作时间的 50%  
  945.   // 则视为空闲。  
  946.   Result :=  
  947.     (FCurState in [tcsWaiting, tcsCheckingDown]) and  
  948.     (AverageWaitingTime > 100) and  
  949.     (AverageWaitingTime * 2 > AverageProcessingTime);  
  950. end; { TProcessorThread.isIdle }  
  951.   
  952. function TProcessorThread.NewAverage(OldAvg, NewVal: Integer): Integer;  
  953. begin  
  954.   Result := (OldAvg * 2 + NewVal) div 3;  
  955. end; { TProcessorThread.NewAverage }  
  956.   
  957. procedure TProcessorThread.Terminate;  
  958. begin  
  959.   WriteLog('TProcessorThread.Terminate', 5);  
  960.   inherited Terminate;  
  961.   SetEvent(hThreadTerminated);  
  962. end; { TProcessorThread.Terminate }  
  963.   
  964. procedure TProcessorThread.WriteLog(const Str: string; Level: Integer = 0);  
  965. begin  
  966. {$IFNDEF NOLOGS}  
  967.   uThreadPool.WriteLog(Str, ThreadID, Level);  
  968. {$ENDIF}  
  969. end; { TProcessorThread.WriteLog }  
  970.   
  971. { 
  972. ******************************* TCriticalSection ******************************* 
  973. }  
  974.   
  975. constructor TCriticalSection.Create;  
  976. begin  
  977.   InitializeCriticalSection(FSection);  
  978. end; { TCriticalSection.Create }  
  979.   
  980. destructor TCriticalSection.Destroy;  
  981. begin  
  982.   DeleteCriticalSection(FSection);  
  983. end; { TCriticalSection.Destroy }  
  984.   
  985. procedure TCriticalSection.Enter;  
  986. begin  
  987.   EnterCriticalSection(FSection);  
  988. end; { TCriticalSection.Enter }  
  989.   
  990. procedure TCriticalSection.Leave;  
  991. begin  
  992.   LeaveCriticalSection(FSection);  
  993. end; { TCriticalSection.Leave }  
  994.   
  995. function TCriticalSection.TryEnter: Boolean;  
  996. begin  
  997.   Result := TryEnterCriticalSection(FSection);  
  998. end; { TCriticalSection.TryEnter }  
  999.   
  1000. procedure NoLogs(const Str: string; LogID: Integer = 0; Level: Integer = 0);  
  1001. begin  
  1002. end;  
  1003.   
  1004. initialization  
  1005.   WriteLog := NoLogs;  
  1006. end.  

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

【推广】 免费学中医，健康全家人
原文地址：https://www.cnblogs.com/findumars/p/5338851.html