123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419 |
- {
- $Id$
- fpAsync: Asynchronous event management for Free Pascal
- Copyright (C) 2001 by
- Areca Systems GmbH / Sebastian Guenther, [email protected]
- Common implementation
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- }
- type
- PNotifyData = ^TNotifyData;
- TNotifyData = record
- Next: PNotifyData;
- Notify: TNotifyEvent;
- Sender: TObject;
- case Boolean of
- False: (TimerHandle: TAsyncTimer);
- True: (FileHandle: LongInt);
- end;
- procedure EventHandler(Data: Pointer); cdecl;
- begin
- with PNotifyData(Data)^ do
- Notify(Sender);
- end;
- function AddNotifyData(Obj: TEventLoop): PNotifyData;
- begin
- New(Result);
- Result^.Next := PNotifyData(Obj.FFirstNotifyData);
- Obj.FFirstNotifyData := Result;
- end;
- procedure FreeNotifyData(Obj: TEventLoop; Data: PNotifyData);
- var
- CurData, PrevData, NextData: PNotifyData;
- begin
- PrevData := nil;
- CurData := Obj.FFirstNotifyData;
- while Assigned(CurData) do
- begin
- NextData := CurData^.Next;
- if CurData = Data then
- if Assigned(PrevData) then
- PrevData^.Next := NextData
- else
- Obj.FFirstNotifyData := NextData;
- PrevData := CurData;
- CurData := NextData;
- end;
- Dispose(Data);
- end;
- constructor TEventLoop.Create;
- begin
- asyncInit(Handle);
- end;
- destructor TEventLoop.Destroy;
- var
- NotifyData, NextNotifyData: PNotifyData;
- begin
- asyncFree(Handle);
- NotifyData := FFirstNotifyData;
- while Assigned(NotifyData) do
- begin
- NextNotifyData := NotifyData^.Next;
- Dispose(NotifyData);
- NotifyData := NextNotifyData;
- end;
- end;
- function TEventLoop.Handle: TAsyncHandle;
- begin
- Result := TAsyncHandle(Self);
- end;
- procedure TEventLoop.Run;
- begin
- asyncRun(Handle);
- end;
- procedure TEventLoop.Break;
- begin
- asyncBreak(Handle);
- end;
- function TEventLoop.AddTimerCallback(AMSec: LongInt; APeriodic: Boolean;
- ACallback: TAsyncCallback; AUserData: Pointer): TAsyncTimer;
- begin
- Result := asyncAddTimer(Handle, AMSec, APeriodic, ACallback, AUserData);
- end;
- procedure TEventLoop.RemoveTimerCallback(ATimer: TAsyncTimer);
- begin
- asyncRemoveTimer(Handle, ATimer);
- end;
- function TEventLoop.AddTimerNotify(AMSec: LongInt; APeriodic: Boolean;
- ANotify: TNotifyEvent; ASender: TObject): Pointer;
- var
- UserData: PNotifyData;
- begin
- UserData := AddNotifyData(Self);
- UserData^.Notify := ANotify;
- UserData^.Sender := ASender;
- UserData^.TimerHandle :=
- asyncAddTimer(Handle, AMSec, APeriodic, @EventHandler, UserData);
- Result := UserData;
- end;
- procedure TEventLoop.RemoveTimerNotify(AHandle: Pointer);
- var
- Data: PNotifyData;
- begin
- Data := PNotifyData(AHandle);
- asyncRemoveTimer(Handle, Data^.TimerHandle);
- FreeNotifyData(Self, Data);
- end;
- procedure TEventLoop.SetIOCallback(AHandle: Integer; ACallback: TAsyncCallback;
- AUserData: Pointer);
- begin
- asyncSetIOCallback(Handle, AHandle, ACallback, AUserData);
- end;
- procedure TEventLoop.ClearIOCallback(AHandle: Integer);
- begin
- asyncClearIOCallback(Handle, AHandle);
- end;
- function TEventLoop.SetIONotify(AHandle: Integer; ANotify: TNotifyEvent;
- ASender: TObject): Pointer;
- var
- UserData: PNotifyData;
- begin
- UserData := AddNotifyData(Self);
- UserData^.Notify := ANotify;
- UserData^.Sender := ASender;
- UserData^.FileHandle := AHandle;
- asyncSetIOCallback(Handle, AHandle, @EventHandler, UserData);
- Result := UserData;
- end;
- procedure TEventLoop.ClearIONotify(AHandle: Pointer);
- var
- Data: PNotifyData;
- begin
- Data := PNotifyData(AHandle);
- asyncClearIOCallback(Handle, Data^.FileHandle);
- FreeNotifyData(Self, Data);
- end;
- procedure TEventLoop.SetDataAvailableCallback(AHandle: Integer; ACallback: TAsyncCallback;
- AUserData: Pointer);
- begin
- asyncSetDataAvailableCallback(Handle, AHandle, ACallback, AUserData);
- end;
- procedure TEventLoop.ClearDataAvailableCallback(AHandle: Integer);
- begin
- asyncClearDataAvailableCallback(Handle, AHandle);
- end;
- function TEventLoop.SetDataAvailableNotify(AHandle: Integer; ANotify: TNotifyEvent;
- ASender: TObject): Pointer;
- var
- UserData: PNotifyData;
- begin
- UserData := AddNotifyData(Self);
- UserData^.Notify := ANotify;
- UserData^.Sender := ASender;
- UserData^.FileHandle := AHandle;
- asyncSetDataAvailableCallback(Handle, AHandle, @EventHandler, UserData);
- Result := UserData;
- end;
- procedure TEventLoop.ClearDataAvailableNotify(AHandle: Pointer);
- var
- Data: PNotifyData;
- begin
- Data := PNotifyData(AHandle);
- asyncClearDataAvailableCallback(Handle, Data^.FileHandle);
- FreeNotifyData(Self, Data);
- end;
- procedure TEventLoop.SetCanWriteCallback(AHandle: Integer; ACallback: TAsyncCallback;
- AUserData: Pointer);
- begin
- asyncSetCanWriteCallback(Handle, AHandle, ACallback, AUserData);
- end;
- procedure TEventLoop.ClearCanWriteCallback(AHandle: Integer);
- begin
- asyncClearCanWriteCallback(Handle, AHandle);
- end;
- function TEventLoop.SetCanWriteNotify(AHandle: Integer; ANotify: TNotifyEvent;
- ASender: TObject): Pointer;
- var
- UserData: PNotifyData;
- begin
- UserData := AddNotifyData(Self);
- UserData^.Notify := ANotify;
- UserData^.Sender := ASender;
- UserData^.FileHandle := AHandle;
- asyncSetCanWriteCallback(Handle, AHandle, @EventHandler, UserData);
- Result := UserData;
- end;
- procedure TEventLoop.ClearCanWriteNotify(AHandle: Pointer);
- var
- Data: PNotifyData;
- begin
- Data := PNotifyData(AHandle);
- asyncClearCanWriteCallback(Handle, Data^.FileHandle);
- FreeNotifyData(Self, Data);
- end;
- function TEventLoop.TimerTicks: Int64;
- begin
- Result := asyncGetTicks;
- end;
- function TEventLoop.GetIsRunning: Boolean;
- begin
- Result := asyncIsRunning(Handle);
- end;
- procedure TEventLoop.SetIsRunning(AIsRunning: Boolean);
- begin
- if IsRunning then
- begin
- if not AIsRunning then
- Run;
- end else
- if AIsRunning then
- Break;
- end;
- // -------------------------------------------------------------------
- // TWriteBuffer
- // -------------------------------------------------------------------
- procedure TWriteBuffer.BufferEmpty;
- begin
- if Assigned(FOnBufferEmpty) then
- FOnBufferEmpty(Self);
- end;
- constructor TWriteBuffer.Create;
- begin
- inherited Create;
- FBuffer := nil;
- FBytesInBuffer := 0;
- EndOfLineMarker := #10;
- end;
- destructor TWriteBuffer.Destroy;
- begin
- if Assigned(FBuffer) then
- FreeMem(FBuffer);
- inherited Destroy;
- end;
- function TWriteBuffer.Seek(Offset: LongInt; Origin: Word): LongInt;
- begin
- if ((Offset = 0) and ((Origin = soFromCurrent) or (Origin = soFromEnd))) or
- ((Offset = FBytesInBuffer) and (Origin = soFromBeginning)) then
- Result := FBytesInBuffer
- else
- // !!!: No i18n for this string - solve this problem in the FCL?!?
- raise EStreamError.Create('Invalid stream operation');
- end;
- function TWriteBuffer.Write(const ABuffer; Count: LongInt): LongInt;
- begin
- ReallocMem(FBuffer, FBytesInBuffer + Count);
- Move(ABuffer, FBuffer[FBytesInBuffer], Count);
- Inc(FBytesInBuffer, Count);
- WantWrite;
- Result := Count;
- end;
- procedure TWriteBuffer.WriteLine(const line: String);
- var
- s: String;
- begin
- s := line + EndOfLineMarker;
- WriteBuffer(s[1], Length(s));
- end;
- procedure TWriteBuffer.Run;
- var
- CurStart, Written: Integer;
- NewBuf: PChar;
- Failed: Boolean;
- begin
- CurStart := 0;
- Failed := True;
- repeat
- if FBytesInBuffer = 0 then
- begin
- BufferEmpty;
- exit;
- end;
- Written := DoRealWrite(FBuffer[CurStart], FBytesInBuffer - CurStart);
- if Written > 0 then
- begin
- Inc(CurStart, Written);
- Failed := False;
- GetMem(NewBuf, FBytesInBuffer - CurStart);
- Move(FBuffer[CurStart], NewBuf[0], FBytesInBuffer - CurStart);
- FreeMem(FBuffer);
- FBuffer := NewBuf;
- Dec(FBytesInBuffer, CurStart);
- end;
- until Written <= 0;
- if Failed then
- WritingFailed;
- end;
- // -------------------------------------------------------------------
- // TAsyncWriteStream
- // -------------------------------------------------------------------
- function TAsyncWriteStream.DoRealWrite(const ABuffer; Count: Integer): Integer;
- begin
- Result := FDataStream.Write(ABuffer, count);
- end;
- procedure TAsyncWriteStream.WritingFailed;
- begin
- if (FDataStream <> FBlockingStream) and Assigned(FNotifyHandle) then
- begin
- FManager.ClearCanWriteNotify(FNotifyHandle);
- FNotifyHandle := nil;
- end;
- end;
- procedure TAsyncWriteStream.WantWrite;
- begin
- FNotifyHandle := FManager.SetCanWriteNotify(FBlockingStream.Handle, @CanWrite, nil);
- end;
- procedure TAsyncWriteStream.BufferEmpty;
- begin
- if Assigned(FNotifyHandle) then
- begin
- FManager.ClearCanWriteNotify(FNotifyHandle);
- FNotifyHandle := nil;
- end;
- inherited BufferEmpty;
- end;
- procedure TAsyncWriteStream.CanWrite(UserData: TObject);
- begin
- Run;
- end;
- constructor TAsyncWriteStream.Create(AManager: TEventLoop; AStream: THandleStream);
- begin
- Self.Create(AManager, AStream, AStream);
- end;
- constructor TAsyncWriteStream.Create(AManager: TEventLoop;
- ADataStream: TStream; ABlockingStream: THandleStream);
- begin
- ASSERT(Assigned(ADataStream) and Assigned(ABlockingStream));
- inherited Create;
- FManager := AManager;
- FDataStream := ADataStream;
- FBlockingStream := ABlockingStream;
- end;
- destructor TAsyncWriteStream.Destroy;
- begin
- if Assigned(FNotifyHandle) then
- FManager.ClearCanWriteNotify(FNotifyHandle);
- inherited Destroy;
- end;
- {
- $Log$
- Revision 1.2 2001-12-11 17:45:28 marco
- * was only commited to fixes.
- Revision 1.1.2.2 2001/11/16 12:51:41 sg
- * Now different handlers for available data and space in write buffer can
- be set
- * LOTS of bugfixes in the implementation
- * fpAsync now has a write buffer class (a read buffer class for reading
- line by line will be included in the next release)
- Revision 1.1.2.1 2001/09/08 15:43:24 sg
- * First public version
- }
|