pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

blcksock.pas - improvements by ACBr

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@256 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2022-01-16 14:14:20 +00:00
parent 8185f7ffd2
commit 9ebe828363
1 changed files with 44 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
blcksock.pas
View File

@ -96,6 +96,10 @@ Core with implementation basic socket classes.
{$WARN IMPLICIT_STRING_CAST_LOSS OFF} {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
{$ENDIF} {$ENDIF}
{$IFDEF NEXTGEN}
{$ZEROBASEDSTRINGS OFF}
{$ENDIF}
unit blcksock; unit blcksock;
interface interface
@ -104,11 +108,14 @@ uses
SysUtils, Classes, SysUtils, Classes,
synafpc, synafpc,
synsock, synautil, synacode, synaip synsock, synautil, synacode, synaip
{$IFDEF CIL} {$IFDEF POSIX}
,System.Generics.Collections, System.Generics.Defaults
{$ENDIF}
{$IfDef CIL}
,System.Net ,System.Net
,System.Net.Sockets ,System.Net.Sockets
,System.Text ,System.Text
{$ENDIF} {$EndIf}
; ;
const const
@ -275,6 +282,16 @@ type
TCustomSSL = class; TCustomSSL = class;
TSSLClass = class of TCustomSSL; TSSLClass = class of TCustomSSL;
TBlockSocket = class;
{$IFDEF POSIX}
TOptionList = TList<TSynaOption>;
TSocketList = TList<TBlockSocket>;
{$ELSE}
TOptionList = TList;
TSocketList = TList;
{$ENDIF}
{:@abstract(Basic IP object.) {:@abstract(Basic IP object.)
This is parent class for other class with protocol implementations. Do not This is parent class for other class with protocol implementations. Do not
use this class directly! Use @link(TICMPBlockSocket), @link(TRAWBlockSocket), use this class directly! Use @link(TICMPBlockSocket), @link(TRAWBlockSocket),
@ -305,7 +322,7 @@ type
FFamilySave: TSocketFamily; FFamilySave: TSocketFamily;
FIP6used: Boolean; FIP6used: Boolean;
FPreferIP4: Boolean; FPreferIP4: Boolean;
FDelayedOptions: TList; FDelayedOptions: TOptionList;
FInterPacketTimeout: Boolean; FInterPacketTimeout: Boolean;
{$IFNDEF CIL} {$IFNDEF CIL}
FFDSet: TFDSet; FFDSet: TFDSet;
@ -395,7 +412,7 @@ type
Warning: when you call : Bind('0.0.0.0','0'); then is nothing done! In this Warning: when you call : Bind('0.0.0.0','0'); then is nothing done! In this
case is used implicit system bind instead.} case is used implicit system bind instead.}
procedure Bind(IP, Port: string); procedure Bind(const IP, Port: string);
{:Connects socket to remote IP address and PORT. The same rules as with {:Connects socket to remote IP address and PORT. The same rules as with
@link(BIND) method are valid. The only exception is that PORT with 0 value @link(BIND) method are valid. The only exception is that PORT with 0 value
@ -423,7 +440,7 @@ type
{:Sends data of LENGTH from BUFFER address via connected socket. System {:Sends data of LENGTH from BUFFER address via connected socket. System
automatically splits data to packets.} automatically splits data to packets.}
function SendBuffer(Buffer: Tmemory; Length: Integer): Integer; virtual; function SendBuffer(const Buffer: Tmemory; Length: Integer): Integer; virtual;
{:One data BYTE is sent via connected socket.} {:One data BYTE is sent via connected socket.}
procedure SendByte(Data: Byte); virtual; procedure SendByte(Data: Byte); virtual;
@ -664,7 +681,7 @@ type
{:Same as @link(SendBuffer), but send datagram to address from {:Same as @link(SendBuffer), but send datagram to address from
@link(RemoteSin). Usefull for sending reply to datagram received by @link(RemoteSin). Usefull for sending reply to datagram received by
function @link(RecvBufferFrom).} function @link(RecvBufferFrom).}
function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; virtual; function SendBufferTo(const Buffer: TMemory; Length: Integer): Integer; virtual;
{:Note: This is low-lever receive function. You must be sure if data is {:Note: This is low-lever receive function. You must be sure if data is
waiting for read before call this function for avoid deadlock! waiting for read before call this function for avoid deadlock!
@ -684,8 +701,8 @@ type
continue. If value in Timeout is -1, run is breaked and waiting for read continue. If value in Timeout is -1, run is breaked and waiting for read
data maybe forever. If is returned @TRUE, CanReadList TList is filled by all data maybe forever. If is returned @TRUE, CanReadList TList is filled by all
TBlockSocket objects what waiting for read.} TBlockSocket objects what waiting for read.}
function GroupCanRead(const SocketList: TList; Timeout: Integer; function GroupCanRead(const SocketList: TSocketList; Timeout: Integer;
const CanReadList: TList): Boolean; const CanReadList: TSocketList): Boolean;
{$ENDIF} {$ENDIF}
{:By this method you may turn address reuse mode for local @link(bind). It {:By this method you may turn address reuse mode for local @link(bind). It
is good specially for UDP protocol. Using this with TCP protocol is is good specially for UDP protocol. Using this with TCP protocol is
@ -1040,7 +1057,7 @@ type
function GetRemoteSinPort: Integer; override; function GetRemoteSinPort: Integer; override;
{:See @link(TBlockSocket.SendBuffer)} {:See @link(TBlockSocket.SendBuffer)}
function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override; function SendBuffer(const Buffer: TMemory; Length: Integer): Integer; override;
{:See @link(TBlockSocket.RecvBuffer)} {:See @link(TBlockSocket.RecvBuffer)}
function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override; function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
@ -1098,7 +1115,7 @@ type
procedure Connect(IP, Port: string); override; procedure Connect(IP, Port: string); override;
{:Silently redirected to @link(TBlockSocket.SendBufferTo).} {:Silently redirected to @link(TBlockSocket.SendBufferTo).}
function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override; function SendBuffer(const Buffer: TMemory; Length: Integer): Integer; override;
{:Silently redirected to @link(TBlockSocket.RecvBufferFrom).} {:Silently redirected to @link(TBlockSocket.RecvBufferFrom).}
function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; override; function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; override;
@ -1127,7 +1144,7 @@ type
procedure EnableBroadcast(Value: Boolean); procedure EnableBroadcast(Value: Boolean);
{:See @link(TBlockSocket.SendBufferTo)} {:See @link(TBlockSocket.SendBufferTo)}
function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; override; function SendBufferTo(const Buffer: TMemory; Length: Integer): Integer; override;
{:See @link(TBlockSocket.RecvBufferFrom)} {:See @link(TBlockSocket.RecvBufferFrom)}
function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; override; function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; override;
@ -1527,7 +1544,7 @@ var
{$ENDIF} {$ENDIF}
begin begin
inherited Create; inherited Create;
FDelayedOptions := TList.Create; FDelayedOptions := TOptionList.Create;
FRaiseExcept := False; FRaiseExcept := False;
{$IFDEF RAISEEXCEPT} {$IFDEF RAISEEXCEPT}
FRaiseExcept := True; FRaiseExcept := True;
@ -1750,7 +1767,7 @@ begin
synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_LOOP), buf, SizeOf(x)); synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_LOOP), buf, SizeOf(x));
end; end;
end; end;
Value.free; Value.Free;
end; end;
procedure TBlockSocket.DelayedOption(const Value: TSynaOption); procedure TBlockSocket.DelayedOption(const Value: TSynaOption);
@ -1897,7 +1914,7 @@ begin
DoStatus(HR_SocketClose, ''); DoStatus(HR_SocketClose, '');
end; end;
procedure TBlockSocket.Bind(IP, Port: string); procedure TBlockSocket.Bind(const IP, Port: string);
var var
Sin: TVarSin; Sin: TVarSin;
begin begin
@ -2016,7 +2033,7 @@ begin
sleep(250); sleep(250);
end; end;
end; end;
Next := GetTick + Trunc((Length / MaxB) * 1000); Next := GetTick + LongWord(Trunc((Length / MaxB) * 1000));
end; end;
end; end;
@ -2033,7 +2050,7 @@ begin
end; end;
function TBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer; function TBlockSocket.SendBuffer(const Buffer: TMemory; Length: Integer): Integer;
{$IFNDEF CIL} {$IFNDEF CIL}
var var
x, y: integer; x, y: integer;
@ -2873,7 +2890,7 @@ begin
Result := CanRead(Timeout); Result := CanRead(Timeout);
end; end;
function TBlockSocket.SendBufferTo(Buffer: TMemory; Length: Integer): Integer; function TBlockSocket.SendBufferTo(const Buffer: TMemory; Length: Integer): Integer;
begin begin
Result := 0; Result := 0;
if TestStopFlag then if TestStopFlag then
@ -2998,8 +3015,8 @@ begin
end; end;
{$IFNDEF CIL} {$IFNDEF CIL}
function TBlockSocket.GroupCanRead(const SocketList: TList; Timeout: Integer; function TBlockSocket.GroupCanRead(const SocketList: TSocketList; Timeout: Integer;
const CanReadList: TList): boolean; const CanReadList: TSocketList): boolean;
var var
FDSet: TFDSet; FDSet: TFDSet;
TimeVal: PTimeVal; TimeVal: PTimeVal;
@ -3557,7 +3574,7 @@ begin
Result := RecvBufferFrom(Buffer, Length); Result := RecvBufferFrom(Buffer, Length);
end; end;
function TDgramBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer; function TDgramBlockSocket.SendBuffer(const Buffer: TMemory; Length: Integer): Integer;
begin begin
Result := SendBufferTo(Buffer, Length); Result := SendBufferTo(Buffer, Length);
end; end;
@ -3617,7 +3634,7 @@ begin
end; end;
end; end;
function TUDPBlockSocket.SendBufferTo(Buffer: TMemory; Length: Integer): Integer; function TUDPBlockSocket.SendBufferTo(const Buffer: TMemory; Length: Integer): Integer;
var var
SIp: string; SIp: string;
SPort: integer; SPort: integer;
@ -3679,7 +3696,7 @@ begin
begin begin
ip6 := StrToIp6(MCastIP); ip6 := StrToIp6(MCastIP);
for n := 0 to 15 do for n := 0 to 15 do
Multicast6.ipv6mr_multiaddr.s6_addr[n] := Ip6[n]; Multicast6.ipv6mr_multiaddr.{$IFDEF POSIX}s6_addr{$ELSE}u6_addr8{$ENDIF}[n] := Ip6[n];
Multicast6.ipv6mr_interface := 0; Multicast6.ipv6mr_interface := 0;
SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_JOIN_GROUP, SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_JOIN_GROUP,
PAnsiChar(@Multicast6), SizeOf(Multicast6))); PAnsiChar(@Multicast6), SizeOf(Multicast6)));
@ -3706,7 +3723,7 @@ begin
begin begin
ip6 := StrToIp6(MCastIP); ip6 := StrToIp6(MCastIP);
for n := 0 to 15 do for n := 0 to 15 do
Multicast6.ipv6mr_multiaddr.s6_addr[n] := Ip6[n]; Multicast6.ipv6mr_multiaddr.{$IFDEF POSIX}s6_addr{$ELSE}u6_addr8{$ENDIF}[n] := Ip6[n];
Multicast6.ipv6mr_interface := 0; Multicast6.ipv6mr_interface := 0;
SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_LEAVE_GROUP, SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_LEAVE_GROUP,
PAnsiChar(@Multicast6), SizeOf(Multicast6))); PAnsiChar(@Multicast6), SizeOf(Multicast6)));
@ -4023,7 +4040,7 @@ begin
Result := inherited RecvBuffer(Buffer, Len); Result := inherited RecvBuffer(Buffer, Len);
end; end;
function TTCPBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer; function TTCPBlockSocket.SendBuffer(const Buffer: TMemory; Length: Integer): Integer;
var var
x, y: integer; x, y: integer;
l, r: integer; l, r: integer;