Heartbeat support for CanWrite. (It enable Heartbeats for ConnectionTimeout too.)

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@204 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2017-06-05 13:48:51 +00:00
parent e321bff9fc
commit 227656b61a

View File

@ -1,9 +1,9 @@
{==============================================================================|
| Project : Ararat Synapse | 009.009.001 |
| Project : Ararat Synapse | 009.010.000 |
|==============================================================================|
| Content: Library base |
|==============================================================================|
| Copyright (c)1999-2013, Lukas Gebauer |
| Copyright (c)1999-2017, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)1999-2013. |
| Portions created by Lukas Gebauer are Copyright (c)1999-2017. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@ -352,6 +352,7 @@ type
function TestStopFlag: Boolean;
procedure InternalSendStream(const Stream: TStream; WithSize, Indy: boolean); virtual;
function InternalCanRead(Timeout: Integer): Boolean; virtual;
function InternalCanWrite(Timeout: Integer): Boolean; virtual;
public
constructor Create;
@ -2801,7 +2802,7 @@ begin
DoStatus(HR_CanRead, '');
end;
function TBlockSocket.CanWrite(Timeout: Integer): Boolean;
function TBlockSocket.InternalCanWrite(Timeout: Integer): Boolean;
{$IFDEF CIL}
begin
Result := FSocket.Poll(Timeout * 1000, SelectMode.SelectWrite);
@ -2824,6 +2825,38 @@ begin
x := 0;
Result := x > 0;
{$ENDIF}
end;
function TBlockSocket.CanWrite(Timeout: Integer): Boolean;
var
ti, tr: Integer;
n: integer;
begin
if (FHeartbeatRate <> 0) and (Timeout <> -1) then
begin
ti := Timeout div FHeartbeatRate;
tr := Timeout mod FHeartbeatRate;
end
else
begin
ti := 0;
tr := Timeout;
end;
Result := InternalCanWrite(tr);
if not Result then
for n := 0 to ti do
begin
DoHeartbeat;
if FStopFlag then
begin
Result := False;
FStopFlag := False;
Break;
end;
Result := InternalCanWrite(FHeartbeatRate);
if Result then
break;
end;
ExceptCheck;
if Result then
DoStatus(HR_CanWrite, '');