IdThreadMgrPool.pas 4.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153
  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 10383: IdThreadMgrPool.pas
  11. {
  12. { Rev 1.0 2002.11.12 10:56:22 PM czhower
  13. }
  14. {
  15. 2002-06-23 -Andrew P.Rybin
  16. -2 deadlock fix (and also in IdThread)
  17. }
  18. unit IdThreadMgrPool;
  19. interface
  20. uses
  21. Classes,
  22. IdThread, IdThreadMgr;
  23. type
  24. TIdThreadMgrPool = class(TIdThreadMgr)
  25. protected
  26. FPoolSize: Integer;
  27. FThreadPool: TThreadList;
  28. //
  29. procedure ThreadStopped(AThread: TIdThread);
  30. public
  31. constructor Create(AOwner: TComponent); override;
  32. destructor Destroy; override;
  33. function GetThread: TIdThread; override;
  34. procedure ReleaseThread(AThread: TIdThread); override;
  35. procedure TerminateThreads; override;
  36. published
  37. property PoolSize: Integer read FPoolSize write FPoolSize default 0;
  38. End;
  39. implementation
  40. uses
  41. IdGlobal,
  42. SysUtils;
  43. { TIdThreadMgrPool }
  44. constructor TIdThreadMgrPool.Create(AOwner: TComponent);
  45. begin
  46. inherited Create(AOwner);
  47. FThreadPool := TThreadList.Create;
  48. end;
  49. destructor TIdThreadMgrPool.Destroy;
  50. var
  51. i: integer;
  52. LThreads: TList;
  53. begin
  54. FPoolSize := 0;
  55. LThreads := FThreadPool.LockList;
  56. try
  57. for i:=0 to LThreads.Count-1 do begin
  58. with TIdThread(LThreads[i]) do begin
  59. //thread can use ComponentStreamSystem, we must prevent deadlock
  60. //Best way for IdUser's: calling TcpServer.Active:=FALSE & TerminateThreads from OnDestroy
  61. FreeOnTerminate := TRUE;
  62. Terminate;
  63. Start;
  64. end;//with
  65. end;
  66. finally FThreadPool.UnlockList; end;
  67. FreeAndNil(FThreadPool);
  68. inherited Destroy;
  69. end;
  70. function TIdThreadMgrPool.GetThread: TIdThread;
  71. var
  72. LThreadPool: TList;
  73. begin
  74. LThreadPool := FThreadPool.LockList;
  75. try
  76. if LThreadPool.Count > 0 then begin
  77. Result := TIdThread(LThreadPool[0]);
  78. LThreadPool.Delete(0);
  79. end else begin
  80. Result := CreateNewThread;
  81. Result.StopMode := smSuspend;
  82. end;
  83. finally FThreadPool.UnlockList; end;
  84. ActiveThreads.Add(Result);
  85. end;
  86. procedure TIdThreadMgrPool.ReleaseThread(AThread: TIdThread);
  87. var
  88. LThreadPool: TList;
  89. begin
  90. with ActiveThreads.LockList do try // To avoid ReleaseThread-code is
  91. if IndexOf(AThread)=-1 then exit; // executed multiple times, because
  92. finally // AThread.Free call ReleaseThread
  93. ActiveThreads.UnlockList; // again. Now we will detect the 2nd
  94. end; // time, and jump out of the routine
  95. ActiveThreads.Remove(AThread); // here.
  96. LThreadPool := FThreadPool.LockList;
  97. try
  98. // PoolSize = 0 means that we will keep all active threads in the thread pool
  99. if ((PoolSize > 0) and (LThreadPool.Count >= PoolSize))
  100. or AThread.Terminated or AThread.Suspended then begin
  101. AThread.OnStopped := NIL;
  102. AThread.FreeOnTerminate := TRUE;
  103. AThread.Terminate;
  104. AThread.Start;//if suspended
  105. end
  106. else begin
  107. AThread.OnStopped := ThreadStopped;
  108. AThread.Stop;//go sleep
  109. end;
  110. finally FThreadPool.UnlockList; end;
  111. End;//ReleaseThread
  112. procedure TIdThreadMgrPool.TerminateThreads;
  113. begin
  114. inherited TerminateThreads;
  115. with FThreadPool.LockList do
  116. try
  117. while Count > 0 do begin
  118. with TIdThread(Items[0]) do begin
  119. FreeOnTerminate := TRUE;
  120. Terminate;
  121. Start; //Stopped==TRUE because Terminated
  122. end;//with
  123. Delete(0);
  124. end;
  125. finally
  126. FThreadPool.UnlockList;
  127. end;
  128. end;
  129. procedure TIdThreadMgrPool.ThreadStopped(AThread: TIdThread);
  130. begin
  131. AThread.OnStopped := NIL; //work is done. prevent from unexpected usage
  132. if Assigned(FThreadPool) and NOT AThread.Terminated then begin
  133. FThreadPool.Add(AThread);
  134. end
  135. else begin
  136. AThread.Terminate; //abnormal situation: application termination or what?
  137. end;
  138. end;
  139. end.