IdThreadSafe.pas 6.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307
  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: 10385: IdThreadSafe.pas
  11. {
  12. { Rev 1.0 2002.11.12 10:56:28 PM czhower
  13. }
  14. unit IdThreadSafe;
  15. interface
  16. uses
  17. Classes,
  18. SyncObjs;
  19. type
  20. TIdThreadSafe = class
  21. protected
  22. FCriticalSection: TCriticalSection;
  23. public
  24. constructor Create; virtual;
  25. destructor Destroy; override;
  26. procedure Lock;
  27. procedure Unlock;
  28. end;
  29. // Yes we know that integer operations are "atomic". However we do not like to rely on
  30. // internal compiler implementation. This is a safe and proper way to keep our code independent
  31. TIdThreadSafeInteger = class(TIdThreadSafe)
  32. protected
  33. FValue: Integer;
  34. //
  35. function GetValue: Integer;
  36. procedure SetValue(const AValue: Integer);
  37. public
  38. function Decrement: Integer;
  39. function Increment: Integer;
  40. //
  41. property Value: Integer read GetValue write SetValue;
  42. end;
  43. TIdThreadSafeCardinal = class(TIdThreadSafe)
  44. protected
  45. FValue: Cardinal;
  46. //
  47. function GetValue: Cardinal;
  48. procedure SetValue(const AValue: Cardinal);
  49. public
  50. function Decrement: Cardinal;
  51. function Increment: Cardinal;
  52. //
  53. property Value: Cardinal read GetValue write SetValue;
  54. end;
  55. TIdThreadSafeString = class(TIdThreadSafe)
  56. protected
  57. FValue: string;
  58. //
  59. function GetValue: string;
  60. procedure SetValue(const AValue: string);
  61. public
  62. procedure Append(const AValue: string);
  63. procedure Prepend(const AValue: string);
  64. //
  65. property Value: string read GetValue write SetValue;
  66. end;
  67. TIdThreadSafeStringList = class(TIdThreadSafe)
  68. protected
  69. FValue: TStringList;
  70. public
  71. constructor Create(const ASorted: Boolean = False); reintroduce;
  72. destructor Destroy; override;
  73. procedure Add(const AItem: string);
  74. procedure AddObject(const AItem: string; AObject: TObject);
  75. procedure Clear;
  76. function Lock: TStringList; reintroduce;
  77. function ObjectByItem(const AItem: string): TObject;
  78. procedure Remove(const AItem: string);
  79. procedure Unlock; reintroduce;
  80. end;
  81. TIdThreadSafeList = class(TThreadList)
  82. public
  83. function IsCountLessThan(const AValue: Cardinal): Boolean;
  84. End;
  85. implementation
  86. uses
  87. IdGlobal, // For FreeAndNil
  88. SysUtils;
  89. { TIdThreadSafe }
  90. constructor TIdThreadSafe.Create;
  91. begin
  92. inherited;
  93. FCriticalSection := TCriticalSection.Create;
  94. end;
  95. destructor TIdThreadSafe.Destroy;
  96. begin
  97. FreeAndNil(FCriticalSection);
  98. inherited;
  99. end;
  100. procedure TIdThreadSafe.Lock;
  101. begin
  102. FCriticalSection.Enter;
  103. end;
  104. procedure TIdThreadSafe.Unlock;
  105. begin
  106. FCriticalSection.Leave;
  107. end;
  108. { TIdThreadSafeInteger }
  109. function TIdThreadSafeInteger.Decrement: Integer;
  110. begin
  111. Lock; try
  112. Result := FValue;
  113. Dec(FValue);
  114. finally Unlock; end;
  115. end;
  116. function TIdThreadSafeInteger.GetValue: Integer;
  117. begin
  118. Lock; try
  119. Result := FValue;
  120. finally Unlock; end;
  121. end;
  122. function TIdThreadSafeInteger.Increment: Integer;
  123. begin
  124. Lock; try
  125. Result := FValue;
  126. Inc(FValue);
  127. finally Unlock; end;
  128. end;
  129. procedure TIdThreadSafeInteger.SetValue(const AValue: Integer);
  130. begin
  131. Lock; try
  132. FValue := AValue;
  133. finally Unlock; end;
  134. end;
  135. { TIdThreadSafeString }
  136. procedure TIdThreadSafeString.Append(const AValue: string);
  137. begin
  138. Lock; try
  139. FValue := FValue + AValue;
  140. finally Unlock; end;
  141. end;
  142. function TIdThreadSafeString.GetValue: string;
  143. begin
  144. Lock; try
  145. Result := FValue;
  146. finally Unlock; end;
  147. end;
  148. procedure TIdThreadSafeString.Prepend(const AValue: string);
  149. begin
  150. Lock; try
  151. FValue := AValue + FValue;
  152. finally Unlock; end;
  153. end;
  154. procedure TIdThreadSafeString.SetValue(const AValue: string);
  155. begin
  156. Lock; try
  157. FValue := AValue;
  158. finally Unlock; end;
  159. end;
  160. { TIdThreadSafeStringList }
  161. procedure TIdThreadSafeStringList.Add(const AItem: string);
  162. begin
  163. with Lock do try
  164. Add(AItem);
  165. finally Unlock; end;
  166. end;
  167. procedure TIdThreadSafeStringList.AddObject(const AItem: string; AObject: TObject);
  168. begin
  169. with Lock do try
  170. AddObject(AItem, AObject);
  171. finally Unlock; end;
  172. end;
  173. procedure TIdThreadSafeStringList.Clear;
  174. begin
  175. with Lock do try
  176. Clear;
  177. finally Unlock; end;
  178. end;
  179. constructor TIdThreadSafeStringList.Create(const ASorted: Boolean = False);
  180. begin
  181. inherited Create;
  182. FValue := TStringList.Create;
  183. FValue.Sorted := ASorted;
  184. end;
  185. destructor TIdThreadSafeStringList.Destroy;
  186. begin
  187. inherited Lock; try
  188. FreeAndNil(FValue);
  189. finally inherited Unlock; end;
  190. inherited;
  191. end;
  192. function TIdThreadSafeStringList.Lock: TStringList;
  193. begin
  194. inherited Lock;
  195. Result := FValue;
  196. end;
  197. function TIdThreadSafeStringList.ObjectByItem(const AItem: string): TObject;
  198. var
  199. i: Integer;
  200. begin
  201. Result := nil;
  202. with Lock do try
  203. i := IndexOf(AItem);
  204. if i > -1 then begin
  205. Result := Objects[i];
  206. end;
  207. finally Unlock; end;
  208. end;
  209. procedure TIdThreadSafeStringList.Remove(const AItem: string);
  210. var
  211. i: Integer;
  212. begin
  213. with Lock do try
  214. i := IndexOf(AItem);
  215. if i > -1 then begin
  216. Delete(i);
  217. end;
  218. finally Unlock; end;
  219. end;
  220. procedure TIdThreadSafeStringList.Unlock;
  221. begin
  222. inherited Unlock;
  223. end;
  224. { TIdThreadSafeCardinal }
  225. function TIdThreadSafeCardinal.Decrement: Cardinal;
  226. begin
  227. Lock; try
  228. Result := FValue;
  229. Dec(FValue);
  230. finally Unlock; end;
  231. end;
  232. function TIdThreadSafeCardinal.GetValue: Cardinal;
  233. begin
  234. Lock; try
  235. Result := FValue;
  236. finally Unlock; end;
  237. end;
  238. function TIdThreadSafeCardinal.Increment: Cardinal;
  239. begin
  240. Lock; try
  241. Result := FValue;
  242. Inc(FValue);
  243. finally Unlock; end;
  244. end;
  245. procedure TIdThreadSafeCardinal.SetValue(const AValue: Cardinal);
  246. begin
  247. Lock; try
  248. FValue := AValue;
  249. finally Unlock; end;
  250. end;
  251. { TIdThreadSafeList }
  252. function TIdThreadSafeList.IsCountLessThan(const AValue: Cardinal): Boolean;
  253. Begin
  254. if Assigned(SELF) then begin
  255. try
  256. Result := Cardinal(LockList.Count) < AValue;
  257. finally
  258. UnlockList;
  259. end;
  260. end else begin
  261. Result := TRUE; // none always <
  262. end;
  263. End;
  264. end.