• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号
登陆 注册

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

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

 

[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;

鲜花
握手
雷人
路过
鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
More+
上一篇：
安装linux版matlab的方法 - 苍生为念发布时间：2022-07-18
下一篇：
Ubantu16.04下创建matlab启动快捷键发布时间：2022-07-18
热门推荐
More+
热门话题
More+
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）

在线QQ客服
地址：深圳市南山区西丽大学城创智工业园
电邮：jeky_zhao#qq.com
移动电话：139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap