Browse Source

* Added TWriteBuffer.OnBufferSent and made this and OnBufferEmpty
working correctly

sg 22 years ago
parent
commit
696f6fde9d
1 changed files with 40 additions and 20 deletions
  1. 40 20
      fcl/inc/fpasync.pp

+ 40 - 20
fcl/inc/fpasync.pp

@@ -147,7 +147,9 @@ type
   protected
   protected
     FBuffer: PChar;
     FBuffer: PChar;
     FBytesInBuffer: Integer;
     FBytesInBuffer: Integer;
+    FBufferSent: Boolean;
     FOnBufferEmpty: TNotifyEvent;
     FOnBufferEmpty: TNotifyEvent;
+    FOnBufferSent: TNotifyEvent;
 
 
     function  Seek(Offset: LongInt; Origin: Word): LongInt; override;
     function  Seek(Offset: LongInt; Origin: Word): LongInt; override;
     function  Write(const ABuffer; Count: LongInt): LongInt; override;
     function  Write(const ABuffer; Count: LongInt): LongInt; override;
@@ -164,7 +166,9 @@ type
     procedure Run;              // Write as many data as possible
     procedure Run;              // Write as many data as possible
 
 
     property BytesInBuffer: Integer read FBytesInBuffer;
     property BytesInBuffer: Integer read FBytesInBuffer;
+    property BufferSent: Boolean read FBufferSent;
     property OnBufferEmpty: TNotifyEvent read FOnBufferEmpty write FOnBufferEmpty;
     property OnBufferEmpty: TNotifyEvent read FOnBufferEmpty write FOnBufferEmpty;
+    property OnBufferSent: TNotifyEvent read FOnBufferSent write FOnBufferSent;
   end;
   end;
 
 
 
 
@@ -312,6 +316,7 @@ begin
   UserData^.Sender := ASender;
   UserData^.Sender := ASender;
   UserData^.TimerHandle :=
   UserData^.TimerHandle :=
     asyncAddTimer(Handle, AMSec, APeriodic, @EventHandler, UserData);
     asyncAddTimer(Handle, AMSec, APeriodic, @EventHandler, UserData);
+  Result := UserData;
 end;
 end;
 
 
 procedure TEventLoop.RemoveTimerNotify(AHandle: Pointer);
 procedure TEventLoop.RemoveTimerNotify(AHandle: Pointer);
@@ -683,12 +688,16 @@ end;
 
 
 function TWriteBuffer.Write(const ABuffer; Count: LongInt): LongInt;
 function TWriteBuffer.Write(const ABuffer; Count: LongInt): LongInt;
 begin
 begin
-  ReallocMem(FBuffer, FBytesInBuffer + Count);
-  Move(ABuffer, FBuffer[FBytesInBuffer], Count);
-  Inc(FBytesInBuffer, Count);
-  if Assigned(fpAsyncWriteBufferDebugStream) then
-    fpAsyncWriteBufferDebugStream.Write(ABuffer, Count);
-  WantWrite;
+  if Count > 0 then
+  begin
+    FBufferSent := False;
+    ReallocMem(FBuffer, FBytesInBuffer + Count);
+    Move(ABuffer, FBuffer[FBytesInBuffer], Count);
+    Inc(FBytesInBuffer, Count);
+    if Assigned(fpAsyncWriteBufferDebugStream) then
+      fpAsyncWriteBufferDebugStream.Write(ABuffer, Count);
+    WantWrite;
+  end;
   Result := Count;
   Result := Count;
 end;
 end;
 
 
@@ -702,29 +711,30 @@ end;
 
 
 procedure TWriteBuffer.Run;
 procedure TWriteBuffer.Run;
 var
 var
-  CurStart, Written: Integer;
+  Written: Integer;
   NewBuf: PChar;
   NewBuf: PChar;
   Failed: Boolean;
   Failed: Boolean;
 begin
 begin
-  CurStart := 0;
   Failed := True;
   Failed := True;
   repeat
   repeat
     if FBytesInBuffer = 0 then
     if FBytesInBuffer = 0 then
     begin
     begin
       BufferEmpty;
       BufferEmpty;
+      if FBufferSent then
+        exit;
+      WantWrite;
       exit;
       exit;
     end;
     end;
 
 
-    Written := DoRealWrite(FBuffer[CurStart], FBytesInBuffer - CurStart);
+    Written := DoRealWrite(FBuffer[0], FBytesInBuffer);
     if Written > 0 then
     if Written > 0 then
     begin
     begin
-      Inc(CurStart, Written);
       Failed := False;
       Failed := False;
-      GetMem(NewBuf, FBytesInBuffer - CurStart);
-      Move(FBuffer[CurStart], NewBuf[0], FBytesInBuffer - CurStart);
+      Dec(FBytesInBuffer, Written);
+      GetMem(NewBuf, FBytesInBuffer);
+      Move(FBuffer[Written], NewBuf[0], FBytesInBuffer);
       FreeMem(FBuffer);
       FreeMem(FBuffer);
       FBuffer := NewBuf;
       FBuffer := NewBuf;
-      Dec(FBytesInBuffer, CurStart);
     end;
     end;
   until Written <= 0;
   until Written <= 0;
 
 
@@ -760,17 +770,23 @@ end;
 
 
 procedure TAsyncWriteStream.BufferEmpty;
 procedure TAsyncWriteStream.BufferEmpty;
 begin
 begin
-  if Assigned(NotifyHandle) then
-  begin
-    EventLoop.ClearCanWriteNotify(NotifyHandle);
-    NotifyHandle := nil;
-  end;
   inherited BufferEmpty;
   inherited BufferEmpty;
 end;
 end;
 
 
 procedure TAsyncWriteStream.CanWrite(UserData: TObject);
 procedure TAsyncWriteStream.CanWrite(UserData: TObject);
 begin
 begin
-  Run;
+  if FBytesInBuffer = 0 then
+  begin
+    if Assigned(NotifyHandle) then
+    begin
+      EventLoop.ClearCanWriteNotify(NotifyHandle);
+      NotifyHandle := nil;
+    end;
+    FBufferSent := True;
+    if Assigned(FOnBufferSent) then
+      FOnBufferSent(Self);
+  end else
+    Run;
   if DoStopAndFree then
   if DoStopAndFree then
     Free;
     Free;
 end;
 end;
@@ -815,7 +831,11 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.3  2003-06-25 08:41:01  sg
+  Revision 1.4  2003-08-03 21:18:40  sg
+  * Added TWriteBuffer.OnBufferSent and made this and OnBufferEmpty
+    working correctly
+
+  Revision 1.3  2003/06/25 08:41:01  sg
   * Fixed serious bug in TGenericLineReader: When the reader gets killed
   * Fixed serious bug in TGenericLineReader: When the reader gets killed
     via StopAndFree during an OnLine callback, the reader now will
     via StopAndFree during an OnLine callback, the reader now will
     immediately stop reading, so that the owner of the reader can process
     immediately stop reading, so that the owner of the reader can process