fpasync.inc 9.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419
  1. {
  2. $Id$
  3. fpAsync: Asynchronous event management for Free Pascal
  4. Copyright (C) 2001 by
  5. Areca Systems GmbH / Sebastian Guenther, [email protected]
  6. Common implementation
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. }
  13. type
  14. PNotifyData = ^TNotifyData;
  15. TNotifyData = record
  16. Next: PNotifyData;
  17. Notify: TNotifyEvent;
  18. Sender: TObject;
  19. case Boolean of
  20. False: (TimerHandle: TAsyncTimer);
  21. True: (FileHandle: LongInt);
  22. end;
  23. procedure EventHandler(Data: Pointer); cdecl;
  24. begin
  25. with PNotifyData(Data)^ do
  26. Notify(Sender);
  27. end;
  28. function AddNotifyData(Obj: TEventLoop): PNotifyData;
  29. begin
  30. New(Result);
  31. Result^.Next := PNotifyData(Obj.FFirstNotifyData);
  32. Obj.FFirstNotifyData := Result;
  33. end;
  34. procedure FreeNotifyData(Obj: TEventLoop; Data: PNotifyData);
  35. var
  36. CurData, PrevData, NextData: PNotifyData;
  37. begin
  38. PrevData := nil;
  39. CurData := Obj.FFirstNotifyData;
  40. while Assigned(CurData) do
  41. begin
  42. NextData := CurData^.Next;
  43. if CurData = Data then
  44. if Assigned(PrevData) then
  45. PrevData^.Next := NextData
  46. else
  47. Obj.FFirstNotifyData := NextData;
  48. PrevData := CurData;
  49. CurData := NextData;
  50. end;
  51. Dispose(Data);
  52. end;
  53. constructor TEventLoop.Create;
  54. begin
  55. asyncInit(Handle);
  56. end;
  57. destructor TEventLoop.Destroy;
  58. var
  59. NotifyData, NextNotifyData: PNotifyData;
  60. begin
  61. asyncFree(Handle);
  62. NotifyData := FFirstNotifyData;
  63. while Assigned(NotifyData) do
  64. begin
  65. NextNotifyData := NotifyData^.Next;
  66. Dispose(NotifyData);
  67. NotifyData := NextNotifyData;
  68. end;
  69. end;
  70. function TEventLoop.Handle: TAsyncHandle;
  71. begin
  72. Result := TAsyncHandle(Self);
  73. end;
  74. procedure TEventLoop.Run;
  75. begin
  76. asyncRun(Handle);
  77. end;
  78. procedure TEventLoop.Break;
  79. begin
  80. asyncBreak(Handle);
  81. end;
  82. function TEventLoop.AddTimerCallback(AMSec: LongInt; APeriodic: Boolean;
  83. ACallback: TAsyncCallback; AUserData: Pointer): TAsyncTimer;
  84. begin
  85. Result := asyncAddTimer(Handle, AMSec, APeriodic, ACallback, AUserData);
  86. end;
  87. procedure TEventLoop.RemoveTimerCallback(ATimer: TAsyncTimer);
  88. begin
  89. asyncRemoveTimer(Handle, ATimer);
  90. end;
  91. function TEventLoop.AddTimerNotify(AMSec: LongInt; APeriodic: Boolean;
  92. ANotify: TNotifyEvent; ASender: TObject): Pointer;
  93. var
  94. UserData: PNotifyData;
  95. begin
  96. UserData := AddNotifyData(Self);
  97. UserData^.Notify := ANotify;
  98. UserData^.Sender := ASender;
  99. UserData^.TimerHandle :=
  100. asyncAddTimer(Handle, AMSec, APeriodic, @EventHandler, UserData);
  101. Result := UserData;
  102. end;
  103. procedure TEventLoop.RemoveTimerNotify(AHandle: Pointer);
  104. var
  105. Data: PNotifyData;
  106. begin
  107. Data := PNotifyData(AHandle);
  108. asyncRemoveTimer(Handle, Data^.TimerHandle);
  109. FreeNotifyData(Self, Data);
  110. end;
  111. procedure TEventLoop.SetIOCallback(AHandle: Integer; ACallback: TAsyncCallback;
  112. AUserData: Pointer);
  113. begin
  114. asyncSetIOCallback(Handle, AHandle, ACallback, AUserData);
  115. end;
  116. procedure TEventLoop.ClearIOCallback(AHandle: Integer);
  117. begin
  118. asyncClearIOCallback(Handle, AHandle);
  119. end;
  120. function TEventLoop.SetIONotify(AHandle: Integer; ANotify: TNotifyEvent;
  121. ASender: TObject): Pointer;
  122. var
  123. UserData: PNotifyData;
  124. begin
  125. UserData := AddNotifyData(Self);
  126. UserData^.Notify := ANotify;
  127. UserData^.Sender := ASender;
  128. UserData^.FileHandle := AHandle;
  129. asyncSetIOCallback(Handle, AHandle, @EventHandler, UserData);
  130. Result := UserData;
  131. end;
  132. procedure TEventLoop.ClearIONotify(AHandle: Pointer);
  133. var
  134. Data: PNotifyData;
  135. begin
  136. Data := PNotifyData(AHandle);
  137. asyncClearIOCallback(Handle, Data^.FileHandle);
  138. FreeNotifyData(Self, Data);
  139. end;
  140. procedure TEventLoop.SetDataAvailableCallback(AHandle: Integer; ACallback: TAsyncCallback;
  141. AUserData: Pointer);
  142. begin
  143. asyncSetDataAvailableCallback(Handle, AHandle, ACallback, AUserData);
  144. end;
  145. procedure TEventLoop.ClearDataAvailableCallback(AHandle: Integer);
  146. begin
  147. asyncClearDataAvailableCallback(Handle, AHandle);
  148. end;
  149. function TEventLoop.SetDataAvailableNotify(AHandle: Integer; ANotify: TNotifyEvent;
  150. ASender: TObject): Pointer;
  151. var
  152. UserData: PNotifyData;
  153. begin
  154. UserData := AddNotifyData(Self);
  155. UserData^.Notify := ANotify;
  156. UserData^.Sender := ASender;
  157. UserData^.FileHandle := AHandle;
  158. asyncSetDataAvailableCallback(Handle, AHandle, @EventHandler, UserData);
  159. Result := UserData;
  160. end;
  161. procedure TEventLoop.ClearDataAvailableNotify(AHandle: Pointer);
  162. var
  163. Data: PNotifyData;
  164. begin
  165. Data := PNotifyData(AHandle);
  166. asyncClearDataAvailableCallback(Handle, Data^.FileHandle);
  167. FreeNotifyData(Self, Data);
  168. end;
  169. procedure TEventLoop.SetCanWriteCallback(AHandle: Integer; ACallback: TAsyncCallback;
  170. AUserData: Pointer);
  171. begin
  172. asyncSetCanWriteCallback(Handle, AHandle, ACallback, AUserData);
  173. end;
  174. procedure TEventLoop.ClearCanWriteCallback(AHandle: Integer);
  175. begin
  176. asyncClearCanWriteCallback(Handle, AHandle);
  177. end;
  178. function TEventLoop.SetCanWriteNotify(AHandle: Integer; ANotify: TNotifyEvent;
  179. ASender: TObject): Pointer;
  180. var
  181. UserData: PNotifyData;
  182. begin
  183. UserData := AddNotifyData(Self);
  184. UserData^.Notify := ANotify;
  185. UserData^.Sender := ASender;
  186. UserData^.FileHandle := AHandle;
  187. asyncSetCanWriteCallback(Handle, AHandle, @EventHandler, UserData);
  188. Result := UserData;
  189. end;
  190. procedure TEventLoop.ClearCanWriteNotify(AHandle: Pointer);
  191. var
  192. Data: PNotifyData;
  193. begin
  194. Data := PNotifyData(AHandle);
  195. asyncClearCanWriteCallback(Handle, Data^.FileHandle);
  196. FreeNotifyData(Self, Data);
  197. end;
  198. function TEventLoop.TimerTicks: Int64;
  199. begin
  200. Result := asyncGetTicks;
  201. end;
  202. function TEventLoop.GetIsRunning: Boolean;
  203. begin
  204. Result := asyncIsRunning(Handle);
  205. end;
  206. procedure TEventLoop.SetIsRunning(AIsRunning: Boolean);
  207. begin
  208. if IsRunning then
  209. begin
  210. if not AIsRunning then
  211. Run;
  212. end else
  213. if AIsRunning then
  214. Break;
  215. end;
  216. // -------------------------------------------------------------------
  217. // TWriteBuffer
  218. // -------------------------------------------------------------------
  219. procedure TWriteBuffer.BufferEmpty;
  220. begin
  221. if Assigned(FOnBufferEmpty) then
  222. FOnBufferEmpty(Self);
  223. end;
  224. constructor TWriteBuffer.Create;
  225. begin
  226. inherited Create;
  227. FBuffer := nil;
  228. FBytesInBuffer := 0;
  229. EndOfLineMarker := #10;
  230. end;
  231. destructor TWriteBuffer.Destroy;
  232. begin
  233. if Assigned(FBuffer) then
  234. FreeMem(FBuffer);
  235. inherited Destroy;
  236. end;
  237. function TWriteBuffer.Seek(Offset: LongInt; Origin: Word): LongInt;
  238. begin
  239. if ((Offset = 0) and ((Origin = soFromCurrent) or (Origin = soFromEnd))) or
  240. ((Offset = FBytesInBuffer) and (Origin = soFromBeginning)) then
  241. Result := FBytesInBuffer
  242. else
  243. // !!!: No i18n for this string - solve this problem in the FCL?!?
  244. raise EStreamError.Create('Invalid stream operation');
  245. end;
  246. function TWriteBuffer.Write(const ABuffer; Count: LongInt): LongInt;
  247. begin
  248. ReallocMem(FBuffer, FBytesInBuffer + Count);
  249. Move(ABuffer, FBuffer[FBytesInBuffer], Count);
  250. Inc(FBytesInBuffer, Count);
  251. WantWrite;
  252. Result := Count;
  253. end;
  254. procedure TWriteBuffer.WriteLine(const line: String);
  255. var
  256. s: String;
  257. begin
  258. s := line + EndOfLineMarker;
  259. WriteBuffer(s[1], Length(s));
  260. end;
  261. procedure TWriteBuffer.Run;
  262. var
  263. CurStart, Written: Integer;
  264. NewBuf: PChar;
  265. Failed: Boolean;
  266. begin
  267. CurStart := 0;
  268. Failed := True;
  269. repeat
  270. if FBytesInBuffer = 0 then
  271. begin
  272. BufferEmpty;
  273. exit;
  274. end;
  275. Written := DoRealWrite(FBuffer[CurStart], FBytesInBuffer - CurStart);
  276. if Written > 0 then
  277. begin
  278. Inc(CurStart, Written);
  279. Failed := False;
  280. GetMem(NewBuf, FBytesInBuffer - CurStart);
  281. Move(FBuffer[CurStart], NewBuf[0], FBytesInBuffer - CurStart);
  282. FreeMem(FBuffer);
  283. FBuffer := NewBuf;
  284. Dec(FBytesInBuffer, CurStart);
  285. end;
  286. until Written <= 0;
  287. if Failed then
  288. WritingFailed;
  289. end;
  290. // -------------------------------------------------------------------
  291. // TAsyncWriteStream
  292. // -------------------------------------------------------------------
  293. function TAsyncWriteStream.DoRealWrite(const ABuffer; Count: Integer): Integer;
  294. begin
  295. Result := FDataStream.Write(ABuffer, count);
  296. end;
  297. procedure TAsyncWriteStream.WritingFailed;
  298. begin
  299. if (FDataStream <> FBlockingStream) and Assigned(FNotifyHandle) then
  300. begin
  301. FManager.ClearCanWriteNotify(FNotifyHandle);
  302. FNotifyHandle := nil;
  303. end;
  304. end;
  305. procedure TAsyncWriteStream.WantWrite;
  306. begin
  307. FNotifyHandle := FManager.SetCanWriteNotify(FBlockingStream.Handle, @CanWrite, nil);
  308. end;
  309. procedure TAsyncWriteStream.BufferEmpty;
  310. begin
  311. if Assigned(FNotifyHandle) then
  312. begin
  313. FManager.ClearCanWriteNotify(FNotifyHandle);
  314. FNotifyHandle := nil;
  315. end;
  316. inherited BufferEmpty;
  317. end;
  318. procedure TAsyncWriteStream.CanWrite(UserData: TObject);
  319. begin
  320. Run;
  321. end;
  322. constructor TAsyncWriteStream.Create(AManager: TEventLoop; AStream: THandleStream);
  323. begin
  324. Self.Create(AManager, AStream, AStream);
  325. end;
  326. constructor TAsyncWriteStream.Create(AManager: TEventLoop;
  327. ADataStream: TStream; ABlockingStream: THandleStream);
  328. begin
  329. ASSERT(Assigned(ADataStream) and Assigned(ABlockingStream));
  330. inherited Create;
  331. FManager := AManager;
  332. FDataStream := ADataStream;
  333. FBlockingStream := ABlockingStream;
  334. end;
  335. destructor TAsyncWriteStream.Destroy;
  336. begin
  337. if Assigned(FNotifyHandle) then
  338. FManager.ClearCanWriteNotify(FNotifyHandle);
  339. inherited Destroy;
  340. end;
  341. {
  342. $Log$
  343. Revision 1.2 2001-12-11 17:45:28 marco
  344. * was only commited to fixes.
  345. Revision 1.1.2.2 2001/11/16 12:51:41 sg
  346. * Now different handlers for available data and space in write buffer can
  347. be set
  348. * LOTS of bugfixes in the implementation
  349. * fpAsync now has a write buffer class (a read buffer class for reading
  350. line by line will be included in the next release)
  351. Revision 1.1.2.1 2001/09/08 15:43:24 sg
  352. * First public version
  353. }