- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
1885 lines
55 KiB
ObjectPascal
1885 lines
55 KiB
ObjectPascal
unit uRODXSock;
|
|
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
// Component: TDXSock
|
|
// Author: G.E. Ozz Nixon Jr. (onixon@dxsock.com)
|
|
// ========================================================================
|
|
// Source Owner: DX, Inc. 1995-2002
|
|
// Copyright: All code is the property of DX, Inc. Licensed for
|
|
// resell by Brain Patchwork DX (tm) and part of the
|
|
// DX (r) product lines, which are (c) 1999-2002
|
|
// DX, Inc. Source may not be distributed without
|
|
// written permission from both Brain Patchwork DX,
|
|
// and DX, Inc.
|
|
// License: (Reminder), None of this code can be added to other
|
|
// developer products without permission. This includes
|
|
// but not limited to DCU's, DCP's, DLL's, OCX's, or
|
|
// any other form of merging our technologies. All of
|
|
// your products released to a public consumer be it
|
|
// shareware, freeware, commercial, etc. must contain a
|
|
// license notification somewhere visible in the
|
|
// application.
|
|
// Example is Internet Explorer - Help->About screen
|
|
// shows the licensed code contained in the application.
|
|
// Code Version: (3rd Generation Code)
|
|
// ========================================================================
|
|
// Description: Low-Level Socket Wrapper as an Object.
|
|
// ========================================================================
|
|
// 3.0a (pre-release)
|
|
// Changes GetMem/FreeMem to SysGetMem/SysFreeMem
|
|
///////////////////////////////////////////////////////////////////////////////
|
|
|
|
interface
|
|
|
|
{$I uRODXSock.def}
|
|
|
|
uses
|
|
{$IFDEF LINUX}
|
|
Libc,
|
|
{$ELSE}
|
|
WinSock,
|
|
{$ENDIF}
|
|
uRODXSocket,
|
|
{$IFDEF CODE_TRACER}
|
|
DXCodeTracer,
|
|
{$ENDIF}
|
|
{$IFDEF TLS_EDITION}
|
|
MjbLIFO,
|
|
BrkApart,
|
|
{$ENDIF}
|
|
Classes;
|
|
|
|
const
|
|
TDXHugeSize=8192{*2}; // 16kb CHUNKS
|
|
TDXXferTimeout: Word = 500; // if data loss then set to 5000
|
|
TDXMaxSocketBuffer: Word = TDXHugeSize; // Winsock Buffer Size
|
|
PeekBufferSize: Byte = 250; // do not go over 250!
|
|
|
|
type
|
|
Str1 = string[1];
|
|
|
|
//
|
|
// * <B>ddAboutToWrite</B> denotes that your Socket Layer
|
|
// filter should encode, or compress the data.
|
|
// * <B>ddAfterRead</B> denotes that your Socket Layer
|
|
// filter should decode, or decompres the data
|
|
// * <B>dFreePointer</B> denotes that your Socket Layer
|
|
// filter should free the work pointer
|
|
TDXDataDirection = (ddAboutToWrite, ddAfterRead, ddCleanRead, ddFreePointer);
|
|
|
|
TDXFilterCallBack = Procedure(DataDirection: TDXDataDirection; Const InData: Pointer; Var OutData: Pointer; Const
|
|
InSize: Integer; Var OutSize: Integer; Var Handled: Boolean; xClientThread: TThread) Of Object;
|
|
|
|
// This controls outbound data only. It was implemented to
|
|
// assist people who wanted to be able to just say send this big
|
|
// chunk of data, without undertsanding the socket layer itself.
|
|
//
|
|
//
|
|
// * <B>bsfRealSmall</B> uses 128 byte block of data.
|
|
// Obviously smaller than a TCP packet. And with Nagle
|
|
// enabled it would actually slow down your output.
|
|
// However, if you are designing a UDP based
|
|
// application, and know the average package size will
|
|
// be under 128 bytes, then you should set your output
|
|
// buffer to this setting. Used: <B>Very Rare</B>
|
|
// * <B>bsfSmall</B> uses 256 byte block of data. Which is
|
|
// a standard TCP packet. Used: <B>Occasionally</B>
|
|
// * <B>bsfNormal</B> uses 512 byte block of data. Which
|
|
// is bigger than a standard TCP packet, but is optimial
|
|
// when you know your data is usually bigger than 256
|
|
// bytes, and smaller than 512. Our testing has shown
|
|
// this to be very optimal when using that rule. Used: <B>Very
|
|
// Frequently</B>
|
|
// * <B>bsfBigger</B> uses a 2048 byte block of data.
|
|
// Again, bigger than a standard TCP packet. Used <B>Very
|
|
// Rare</B>
|
|
// * <B>bsgBiggest</B> uses a 4096 byte block of data.
|
|
// Bigger than a standard TCP packet, but is used very
|
|
// often by people who are porting from DOS based
|
|
// applications to windows. They are used to the old
|
|
// Borland examples which used 4kb buffers for file copy
|
|
// etc. Used: <B>Often</B>
|
|
// * <B>bsfHUGE</B> uses a 8192 byte block of data. Bigger
|
|
// than a standard TCP packet, but produces the best
|
|
// performance. Especially is you plan to just say "Send
|
|
// this data, who cares how big it is". Used: <B>Most
|
|
// Often</B>
|
|
// <B>Note</B> when we point out that the block of data is
|
|
// bigger then a standard TCP packet, that is just a mental note
|
|
// for you. The socket layer will always build the packet to the
|
|
// appropriate network packet size. These buffers are strictly
|
|
// used internally for how to break the data apart and shove it
|
|
// down to the socket layer.
|
|
//
|
|
//
|
|
//
|
|
// Summary
|
|
// Define the packet size between DXSock and the Socket Layer.
|
|
TDXBlockSizeFlags = (
|
|
bsfZero, // special meaning for TLS!
|
|
bsfRealSmall,
|
|
bsfSmall, bsfNormal,
|
|
bsfBigger,
|
|
bsfBiggest,
|
|
bsfHUGE);
|
|
|
|
Type
|
|
TDXBSArray=Array [0..65500] of Char;
|
|
TDXBSArray2=Array [0..250] of Char;
|
|
{$IFDEF VER100}
|
|
Longword=Cardinal;
|
|
{$ENDIF}
|
|
|
|
TDXSock = class
|
|
private
|
|
{$IFDEF CODE_TRACER}
|
|
CodeTracer:TDXCodeTracer;
|
|
{$ENDIF}
|
|
{$IFDEF TLS_EDITION}
|
|
tBuf: TBrkApart;
|
|
tStack: TMJBLIFO;
|
|
Straggler: String;
|
|
{$ENDIF}
|
|
FClientThread:TThread;
|
|
FTLS:Boolean;
|
|
fChunkBuf:Pointer; // 3.0a
|
|
fbClientMode: Boolean;
|
|
fbIsUDP: Boolean;
|
|
fbIsKeepAlive: Boolean;
|
|
FsBindTo: string;
|
|
FPeekBuffer: ^TDXBSArray2;
|
|
FReadTimeout: Boolean;
|
|
FUseBlocking: Boolean;
|
|
FBlockSizeFlags: TDXBlockSizeFlags;
|
|
FActualBlockSize: Integer;
|
|
FErrStatus: Integer;
|
|
fTooManyCharacters: Integer;
|
|
feOnFilter: TDXFilterCallBack;
|
|
{$IFDEF TLS_EDITION}
|
|
feOnReadFilter: TDXFilterCallBack;
|
|
{$ENDIF}
|
|
GlobalPeerPort: Integer;
|
|
GlobalPeerIPAddress: string;
|
|
GlobalTimeout: TTimeVal;
|
|
VarConstSizeofTSockAddrIn:Integer;
|
|
protected
|
|
function GetReleaseDate: string;
|
|
procedure SetReleaseDate(value: string);
|
|
function GetLocalPort: Integer;
|
|
function GetLocalIPAddr: string;
|
|
function IsConnected: Boolean;
|
|
function IsValidSocket: Boolean;
|
|
function IsReadable: Boolean;
|
|
function IsWritable: Boolean;
|
|
function DidReadTimeout: Boolean;
|
|
procedure SetfBlockSizeFlags(Value: TDXBlockSizeFlags);
|
|
function CountWaiting: Integer;
|
|
public
|
|
SockAddr: TSockAddrIn;
|
|
{$IFDEF LINUX}
|
|
Sock: TFileDescriptor;
|
|
{$ELSE}
|
|
Sock: TSocket;
|
|
{$ENDIF}
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function Connect(Parameters: PNewConnect): Boolean;
|
|
function Listen(Parameters: PNewListen): Boolean;
|
|
function Accept(var NewSock: TDXSock): Boolean;
|
|
procedure CloseGracefully;
|
|
procedure Disconnect; // Borland Friendly
|
|
procedure CloseNow;
|
|
function SendBuf(const Buf; Count: Integer): Integer; // Borland friendly
|
|
function ReceiveBuf(var Buf; Count: Integer): Integer; // Borland friendly
|
|
{$IFDEF VER100}
|
|
function BlockWrite(buf: Pointer; len: Integer): Integer;
|
|
function WriteCh(c: Char): Integer;
|
|
function Write(const s: string): Integer;
|
|
{$ELSE}
|
|
function Write(c: Char): Integer; overload;
|
|
function Write(const s: string): Integer; overload;
|
|
function Write(buf: Pointer; len: Integer): Integer; overload;
|
|
{$ENDIF}
|
|
function WriteLn(const s: string): Integer;
|
|
function WriteResultCode(const Code: Integer; const Rslt: string): Integer;
|
|
function WriteWithSize(S: string): Boolean; //2.4 for ASTAIO
|
|
function WriteInteger(const n: integer): integer;
|
|
|
|
{$IFDEF VER100}
|
|
function SendFromStream(Stream: TStream): Boolean;
|
|
function SendFromWindowsFile(var Handle: Integer): boolean;
|
|
function SendFromBorlandFile(var Handle: file): boolean;
|
|
{$ELSE}
|
|
function SendFrom(Stream: TStream): Boolean; overload;
|
|
function SendFrom(var Handle: Integer): boolean; overload;
|
|
function SendFrom(var Handle: file): boolean; overload;
|
|
{$ENDIF}
|
|
function SendFromStreamWithSize(Stream: TStream): Boolean;
|
|
{$IFDEF VER100}
|
|
function BlockRead(buf: Pointer; len: Integer): Integer;
|
|
function Read:Char;
|
|
{$ELSE}
|
|
function Read(buf: Pointer; len: Integer): Integer; overload;
|
|
function Read: Char; overload;
|
|
{$ENDIF}
|
|
function ReadInteger: integer;
|
|
function ReadStr(MaxLength: Integer): string;
|
|
function ReadString(MaxLength: Integer; Timeout: Longword): string;
|
|
function ReadLn(Timeout: Longword): string;
|
|
function ReadCRLF(Timeout: Longword): string;
|
|
function ReadToAnyDelimiter(Timeout: Longword;Delimiter:String): string;
|
|
function ReadNull(Timeout: Longword): string;
|
|
function ReadSpace(Timeout: Longword): string;
|
|
function ReadWithSize: string; // 2.4 for ASTAIO (no TIMEOUT, just error check)
|
|
{$IFDEF VER100}
|
|
function SaveToStream(Stream: TStream; Timeout: Longword): Boolean;
|
|
function SaveToWindowsFile(var Handle: Integer; Timeout: Longword): boolean;
|
|
function SaveToBorlandFile(var Handle: file; Timeout: Longword): boolean;
|
|
{$ELSE}
|
|
function SaveTo(Stream: TStream; Timeout: Longword): Boolean; overload;
|
|
function SaveTo(var Handle: Integer; Timeout: Longword): boolean; overload;
|
|
function SaveTo(var Handle: file; Timeout: Longword): boolean; overload;
|
|
{$ENDIF}
|
|
function SaveToStreamWithSize(Stream: TStream; Timeout: Longword): Boolean;
|
|
function GetChar: Str1;
|
|
function GetByte: Byte;
|
|
function FilterRead(Const InBuf: Pointer; var OutBuf: Pointer; InSize: Integer;xClientThread: TThread): Integer;
|
|
function PeekString: string;
|
|
function PeekChar: Char;
|
|
function GetErrorStr: string;
|
|
function GetErrorDesc(errorCode: Integer): string;
|
|
procedure SetNagle(TurnOn: Boolean);
|
|
procedure SetBlocking(TurnOn: Boolean);
|
|
procedure WinsockVersion(var WinsockInfo: PWinsockInfo);
|
|
// made public for new TDXSockClient:
|
|
procedure SockClientSetGlobal(I:String;P:Integer);
|
|
procedure SetTimeoutAndBuffer(SocketHandle: Integer);
|
|
// new 3.0 features:
|
|
Function DroppedConnection:Boolean;
|
|
Function WaitForData(timeout:Longint):Boolean;
|
|
//published
|
|
property TLSActive: Boolean read FTLS write FTLS;
|
|
property TLSClientThread: TThread read FClientThread write FClientThread;
|
|
property BindTo: string read fsBindTo
|
|
write fsBindTo;
|
|
property Connected: Boolean read IsConnected;
|
|
property CharactersToRead: Integer read CountWaiting;
|
|
property ReceiveLength: Integer read CountWaiting; // Borland Friendly
|
|
property ValidSocket: Boolean read IsValidSocket;
|
|
property LastReadTimeout: Boolean read DidReadTimeout;
|
|
property LastCommandStatus: Integer read FErrStatus write FErrStatus;
|
|
property OutputBufferSize: TDXBlockSizeFlags read fBlockSizeFlags
|
|
write SetfBlockSizeFlags;
|
|
property TooManyCharacters: Integer read fTooManyCharacters
|
|
write fTooManyCharacters;
|
|
property IsUDPMode: Boolean read fbIsUDP
|
|
write fbIsUDP;
|
|
property IsKeepAliveMode: Boolean read fbIsKeepAlive write fbIsKeepAlive;
|
|
property PeerIPAddress: string read GlobalPeerIPAddress
|
|
write GlobalPeerIPAddress;
|
|
property PeerPort: Integer read GlobalPeerPort
|
|
write GlobalPeerPort;
|
|
property LocalIPAddress: string read GetLocalIPAddr;
|
|
property LocalPort: Integer read GetLocalPort;
|
|
property Readable: Boolean read IsReadable;
|
|
property Writable: Boolean read IsWritable;
|
|
property ReleaseDate: string read GetReleaseDate
|
|
write SetReleaseDate;
|
|
property OnFilter: TDXFilterCallBack read feOnFilter
|
|
write feOnFilter;
|
|
{$IFDEF CODE_TRACER}
|
|
property DXCodeTracer:TDXCodeTracer read CodeTracer
|
|
write CodeTracer;
|
|
{$ENDIF}
|
|
{$IFDEF TLS_EDITION}
|
|
Property OnReadFilter: TDXFilterCallBack READ feOnReadFilter
|
|
WRITE feOnReadFilter;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFNDEF LINUX}
|
|
Windows,
|
|
{$ENDIF}
|
|
uRODXString,
|
|
SysUtils;
|
|
|
|
function TDXSock.GetReleaseDate: string;
|
|
begin
|
|
Result := BPDX_RELEASE_DATE;
|
|
end;
|
|
|
|
procedure TDXSock.SetReleaseDate(value: string);
|
|
begin
|
|
// Absorb!
|
|
end;
|
|
|
|
constructor TDXSock.Create;
|
|
begin
|
|
inherited Create;
|
|
FReadTimeout := False;
|
|
FPeekBuffer:=SysGetMem(PeekBufferSize);
|
|
fChunkBuf:=Nil;
|
|
SetFBlockSizeFlags(bsfNormal); // allocates fChunkBuf
|
|
if not SocketLayerLoaded then
|
|
ShowMessageWindow('Fatal Socket Error', '(WSAStartup) ' + GetErrorStr);
|
|
fTooManyCharacters := 2048;
|
|
Sock := INVALID_SOCKET;
|
|
fbIsUDP := False;
|
|
fbIsKeepAlive := False;
|
|
fbClientMode := False;
|
|
FUseBlocking := True;
|
|
GlobalPeerPort := 0;
|
|
GlobalPeerIPAddress := '';
|
|
GlobalTimeout.tv_Sec := 0;
|
|
GlobalTimeout.tv_uSec := 10000;
|
|
VarConstSizeofTSockAddrIn := ConstSizeofTSockAddrIn;
|
|
end;
|
|
|
|
destructor TDXSock.Destroy;
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.EndTransaction;
|
|
End;
|
|
{$ENDIF}
|
|
{$IFDEF TLS_EDITION}
|
|
If assigned(tstack) Then Begin
|
|
tStack.Free;
|
|
tStack := Nil;
|
|
End;
|
|
{$ENDIF}
|
|
If Assigned(fChunkBuf) then SysFreeMem(fChunkBuf); //,FActualBlockSize);
|
|
fChunkBuf:=Nil;
|
|
if Assigned(FPeekBuffer) then SysFreeMem(FPeekBuffer); // ,PeekBufferSize);
|
|
fPeekBuffer:=Nil;
|
|
if Sock <> INVALID_SOCKET then CloseNow;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TDXSock.SetTimeoutAndBuffer(SocketHandle: Integer);
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.SetTimeoutAndBuffer('+IntToStr(SocketHandle)+')');
|
|
End;
|
|
{$ENDIF}
|
|
SetReceiveTimeout(SocketHandle, TDXXferTimeout, FErrStatus);
|
|
SetSendTimeout(SocketHandle, TDXXferTimeout, FErrStatus);
|
|
SetSendBuffer(SocketHandle, TDXMaxSocketBuffer, FErrStatus);
|
|
// Certain Protocol Implementations you may want to add the div 2
|
|
SetReceiveBuffer(SocketHandle, TDXMaxSocketBuffer div 2, FErrStatus);
|
|
FErrStatus := 0;
|
|
end;
|
|
|
|
function TDXSock.Connect(Parameters: PNewConnect): Boolean;
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.StartTransaction;
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.Connect');
|
|
End;
|
|
{$ENDIF}
|
|
Result := False;
|
|
with Parameters^ do begin
|
|
FUseBlocking := UseBlocking;
|
|
fbIsUDP := UseUDP;
|
|
Sock := ClientConnectToServer(ipAddress, Port, UseUDP, UseNAGLE, @SockAddr, FErrStatus);
|
|
if (FErrStatus <> 0) then Exit;
|
|
GlobalPeerPort := ntohs(SockAddr.sin_port);
|
|
GlobalPeerIPAddress := inet_ntoa(SockAddr.sin_addr);
|
|
uRODXSocket.SetBlocking(Sock, UseBlocking, FErrStatus);
|
|
fbIsKeepAlive := False;
|
|
if not FbIsUDP then begin
|
|
SetSockStatusBool(Sock, SO_KeepAlive, True, FErrStatus);
|
|
fbIsKeepAlive := FErrStatus = 0;
|
|
end;
|
|
SetTimeoutAndBuffer(Sock);
|
|
// 3.0c
|
|
if FbIsUDP then begin
|
|
// try to scale up the primary buffer.
|
|
SetReceiveBuffer(Sock, TDXMaxSocketBuffer*4, FErrStatus);
|
|
If FErrStatus<>0 then
|
|
SetReceiveBuffer(Sock, TDXMaxSocketBuffer*3, FErrStatus);
|
|
If FErrStatus<>0 then
|
|
SetReceiveBuffer(Sock, TDXMaxSocketBuffer*2, FErrStatus);
|
|
If FErrStatus<>0 then
|
|
SetReceiveBuffer(Sock, TDXMaxSocketBuffer, FErrStatus);
|
|
End;
|
|
end;
|
|
fbClientMode := True;
|
|
Result := True;
|
|
end;
|
|
|
|
function TDXSock.Listen(Parameters: PNewListen): Boolean;
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.StartTransaction;
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.Listen');
|
|
End;
|
|
{$ENDIF}
|
|
Result := False;
|
|
with Parameters^ do begin
|
|
FUseBlocking := UseBlocking;
|
|
Sock := BindAndListen(fsBindTo, Port, WinsockQueue, UseUDP, UseNAGLE,
|
|
Connectionless, @SockAddr, FErrStatus);
|
|
fbIsUDP := UseUDP;
|
|
If Sock=Invalid_Socket then Exit; // linux does not set FErrStatus!
|
|
if FErrStatus = 0 then uRODXSocket.SetBlocking(Sock, UseBlocking, FErrStatus)
|
|
else Exit;
|
|
if not fbIsUDP then begin
|
|
SetSockStatusBool(Sock, SO_KeepAlive, True, FErrStatus);
|
|
fbIsKeepAlive := fErrStatus = 0;
|
|
end;
|
|
SetTimeoutAndBuffer(Sock);
|
|
end;
|
|
fErrStatus := 0;
|
|
fbClientMode := False;
|
|
Result := True;
|
|
GlobalPeerPort := 0;
|
|
GlobalPeerIPAddress := '';
|
|
end;
|
|
|
|
function TDXSock.Accept(var NewSock: TDXSock): Boolean;
|
|
var
|
|
ICreatedIt: Boolean;
|
|
|
|
begin
|
|
Result:=False;
|
|
if Sock=INVALID_SOCKET then exit;
|
|
Result:=IsAcceptWaiting(Sock);
|
|
if (not Result) or fbIsUDP then Exit;
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.Accept');
|
|
End;
|
|
{$ENDIF}
|
|
ICreatedIt:=not Assigned(NewSock);
|
|
If ICreatedIt then NewSock := TDXSock.Create;
|
|
NewSock.Sock := AcceptNewConnect(Sock, @NewSock.SockAddr, @VarConstSizeofTSockAddrIn, FErrStatus);
|
|
if FErrStatus <> 0 then begin
|
|
NewSock.Sock := Invalid_Socket;
|
|
if ICreatedIt then begin
|
|
NewSock.Free;
|
|
NewSock := nil;
|
|
end;
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
NewSock.GlobalPeerPort := ntohs(NewSock.SockAddr.sin_port);
|
|
NewSock.GlobalPeerIPAddress := inet_ntoa(NewSock.SockAddr.sin_addr);
|
|
NewSock.fbClientMode := False;
|
|
// SetTimeoutAndBuffer(NewSock.Sock);
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
NewSock.DXCodeTracer:=CodeTracer; // link new sessions automatically
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.Accepted/Configured');
|
|
End;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF VER100}
|
|
function TDXSock.BlockWrite(buf: Pointer; len: Integer): Integer;
|
|
{$ELSE}
|
|
function TDXSock.Write(buf: Pointer; len: Integer): Integer;
|
|
{$ENDIF}
|
|
var
|
|
BytesLeft: Integer;
|
|
BytesSent: Integer;
|
|
XferSize: Integer;
|
|
TmpP: Pointer;
|
|
Filtered: Pointer;
|
|
NewLen: Integer;
|
|
Handled: Boolean;
|
|
|
|
begin
|
|
{$IFDEF TLS_EDITION}
|
|
DoSleepEx(0);
|
|
{$ENDIF}
|
|
Result := 0;
|
|
if Sock = INVALID_SOCKET then Exit;
|
|
if (Len < 1) then begin
|
|
if fbIsUDP then Begin
|
|
UDPSend(Sock, Buf^, 0, 0, SockAddr, ConstSizeofTSockAddrIn, FErrStatus); // 2.3 - empty udp packet
|
|
GlobalPeerPort := ntohs(SockAddr.sin_port);
|
|
GlobalPeerIPAddress := inet_ntoa(SockAddr.sin_addr);
|
|
End;
|
|
Exit;
|
|
end;
|
|
NewLen := 0;
|
|
if Assigned(feOnFilter) then begin
|
|
Handled := False;
|
|
Filtered := nil;
|
|
feOnFilter(ddAboutToWrite, Buf, Filtered, Len, NewLen, Handled,FClientThread);
|
|
if not Handled then begin
|
|
fErrStatus := 9999; {onFilter failed!}
|
|
Exit;
|
|
end;
|
|
end;
|
|
if fbIsUDP then begin
|
|
if NewLen = 0 then
|
|
Result := UDPSend(Sock, Buf^, Len, 0, SockAddr, ConstSizeofTSockAddrIn, FErrStatus)
|
|
else begin
|
|
Result := UDPSend(Sock, Filtered^, NewLen, 0, SockAddr, ConstSizeofTSockAddrIn, FErrStatus);
|
|
if Assigned(feOnFilter) then
|
|
feOnFilter(ddFreePointer, Filtered, Filtered, NewLen, NewLen, Handled,FClientThread);
|
|
end;
|
|
GlobalPeerPort := ntohs(SockAddr.sin_port);
|
|
GlobalPeerIPAddress := inet_ntoa(SockAddr.sin_addr);
|
|
Exit;
|
|
end;
|
|
if NewLen = 0 then begin
|
|
BytesLeft := Len;
|
|
TmpP := Buf;
|
|
end
|
|
else begin
|
|
BytesLeft := NewLen;
|
|
Len := NewLen;
|
|
TmpP := Filtered;
|
|
end;
|
|
fErrStatus := 0;
|
|
repeat
|
|
XferSize:=BytesLeft;
|
|
{$IFNDEF LINUX}
|
|
If IsWritAble then Begin
|
|
{$ENDIF}
|
|
// If XFerSize>FActualBlockSize then XFerSize:=FActualBlockSize;
|
|
BytesSent := BasicSend(Sock, TmpP^, XferSize, 0, FErrStatus);
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.Write SENT: ['+IntToStr(BytesSent)+' bytes] FErrStatus='+IntToStr(FErrStatus));
|
|
End;
|
|
{$ENDIF}
|
|
Case BytesSent of
|
|
-1:Begin
|
|
Case fErrStatus of
|
|
WSAENOBUFS:fErrStatus := 0;
|
|
WSAETIMEDOUT:Begin
|
|
// if this code is execute then TDXXferTimeout is too small!
|
|
fErrStatus := 0;
|
|
Break;
|
|
End;
|
|
WSAECONNABORTED:CloseNow;
|
|
End;
|
|
End;
|
|
0:CloseNow;
|
|
else begin
|
|
If BytesSent>0 then Dec(BytesLeft,BytesSent);
|
|
If (BytesLeft>0) and (fErrStatus=0) then begin// 3.0 [major bug fix!!]
|
|
Inc(LongInt(TmpP), BytesSent);
|
|
End;
|
|
End;
|
|
end;
|
|
{$IFNDEF LINUX}
|
|
End; // Is Write able.
|
|
{$ENDIF}
|
|
until (BytesLeft=0) or (FErrStatus<>0) or (sock=Invalid_Socket);
|
|
Result := Len - BytesLeft;
|
|
if Assigned(feOnFilter) then
|
|
feOnFilter(ddFreePointer, nil, Filtered, NewLen, NewLen, Handled,FClientThread);
|
|
end;
|
|
|
|
function TDXSock.WriteInteger(const n: integer): integer;
|
|
var
|
|
x: integer;
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.WriteInteger('+IntToStr(N)+')');
|
|
End;
|
|
{$ENDIF}
|
|
x := htonl(n);
|
|
{$IFDEF VER100}
|
|
result := BlockWrite(@x, sizeof(x));
|
|
{$ELSE}
|
|
result := Write(@x, sizeof(x));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF VER100}
|
|
function TDXSock.WriteCh(c: Char): Integer;
|
|
{$ELSE}
|
|
function TDXSock.Write(c: Char): Integer;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.WriteCh('+C+')');
|
|
End;
|
|
{$ENDIF}
|
|
{$IFDEF VER100}
|
|
Result := BlockWrite(@C, 1);
|
|
{$ELSE}
|
|
Result := Write(@C, 1);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDXSock.Write(const s: string): Integer;
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.Write('+S+')');
|
|
End;
|
|
{$ENDIF}
|
|
{$IFDEF VER100}
|
|
Result := BlockWrite(@S[1], Length(S));
|
|
{$ELSE}
|
|
Result := Write(@S[1], Length(S));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDXSock.WriteLn(const s: string): Integer;
|
|
var
|
|
Len: Integer;
|
|
Ws: string;
|
|
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.WriteLn('+S+')');
|
|
End;
|
|
{$ENDIF}
|
|
if Assigned(feOnFilter) then begin
|
|
Len := 2;
|
|
Result := Write(S) + Len; // send via filter
|
|
Ws := #13#10;
|
|
if fbIsUDP then begin // append CRLF unfiltered!
|
|
UDPSend(Sock, Ws[1], Len, 0, SockAddr, ConstSizeofTSockAddrIn, FErrStatus);
|
|
end
|
|
else begin
|
|
BasicSend(Sock, Ws[1], Len, 0, FErrStatus);
|
|
end;
|
|
end
|
|
else
|
|
Result := Write(S+#13#10);
|
|
end;
|
|
|
|
function TDXSock.WriteResultCode(const Code: Integer; const Rslt: string): Integer;
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.WriteResult()');
|
|
End;
|
|
{$ENDIF}
|
|
Result:=Writeln(IntToStr(Code)+#32+Rslt);
|
|
end;
|
|
|
|
function TDXSock.ReadInteger: integer;
|
|
var
|
|
n: integer;
|
|
cnt: integer;
|
|
|
|
begin
|
|
{$IFDEF VER100}
|
|
cnt := BlockRead(@n, sizeof(n));
|
|
{$ELSE}
|
|
cnt := Read(@n, sizeof(n));
|
|
{$ENDIF}
|
|
if cnt = sizeof(n) then begin
|
|
n := ntohl(n);
|
|
result := n;
|
|
end
|
|
else result := -1;
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.ReadInteger='+IntToStr(Result));
|
|
End;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF VER100}
|
|
function TDXSock.BlockRead(buf: Pointer; len:Integer): Integer;
|
|
{$ELSE}
|
|
function TDXSock.Read(buf: Pointer; len:Integer): Integer;
|
|
{$ENDIF}
|
|
var
|
|
UDPAddrSize: Integer;
|
|
Tries:Integer;
|
|
{$IFDEF TLS_EDITION}
|
|
Filtered, InData: Pointer;
|
|
Handled: Boolean;
|
|
NewLen: Integer;
|
|
StartTime: Longword;
|
|
SizeToRead: Integer;
|
|
{$ENDIF}
|
|
|
|
begin
|
|
// 7-27 try
|
|
{$IFDEF TLS_EDITION}
|
|
DoSleepEx(0);
|
|
{$ENDIF}
|
|
fReadTimeout := False;
|
|
Result := 0;
|
|
if (Sock=INVALID_SOCKET) or (Len<1) then exit;
|
|
Tries:=0;
|
|
if fbIsUDP then begin
|
|
UDPAddrSize := ConstSizeofTSockAddrIn;
|
|
Result := UDPRecv(Sock, Buf^, Len, 0, SockAddr, UDPAddrSize, FErrStatus);
|
|
GlobalPeerPort := ntohs(SockAddr.sin_port);
|
|
GlobalPeerIPAddress := inet_ntoa(SockAddr.sin_addr);
|
|
end
|
|
else begin
|
|
While (Not IsReadAble) and (Tries<3) Do Begin
|
|
DoSleepEx(1);
|
|
Inc(Tries);
|
|
End;
|
|
{$IFNDEF TLS_EDITION}
|
|
If (CountWaiting>0) or (Tries>=3) then Begin
|
|
Result := BasicRecv(Sock, Buf^, Len, 0, FErrStatus);
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
If (Result=-1) and (fErrStatus=10060) then {absorb}
|
|
Else
|
|
If Result>0 then
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.Read RECV: '+PChar(Buf)+' ['+IntToStr(Result)+'] fes='+IntToStr(FErrStatus))
|
|
Else
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.Read RECV: ['+IntToStr(Result)+'] fes='+IntToStr(FErrStatus));
|
|
End;
|
|
{$ENDIF}
|
|
End;
|
|
{$ELSE}
|
|
If (CountWaiting > 0) Or (Tries >= 3) Then
|
|
Begin
|
|
If Assigned(feOnFilter) Then
|
|
Begin
|
|
SetBlocking(True);
|
|
SizeToRead := 0;
|
|
StartTime := DxString.TimeCounter + 120000;
|
|
While (SizeToRead = 0) And Connected And (Not DXString.Timeout(StartTime)) Do
|
|
Begin
|
|
ioctlsocket(Sock, FIONREAD, Longint(SizeToRead));
|
|
DoSleepEx(1);
|
|
End;
|
|
If SizeToRead <> 0 Then Begin
|
|
InData := Nil;
|
|
Filtered:=Nil;
|
|
// Freemem(Buf,Len);
|
|
GetMem(InData, SizeToRead);
|
|
Result := Recv(Sock, InData^, SizeToRead, 0);
|
|
End;
|
|
End
|
|
Else Result := BasicRecv(Sock, Buf^, Len, 0, FErrStatus);
|
|
End;
|
|
End;
|
|
If Result = 0 Then CloseGracefully;
|
|
fReadTimeout := Result < 1;
|
|
If (Result > 0) And Assigned(feOnFilter) Then
|
|
Begin
|
|
Handled := False; Len :=0;
|
|
feOnFilter(ddAfterRead, InData, Filtered, SizeToRead, Len, Handled, FClientThread);
|
|
If Not Handled Then
|
|
Begin
|
|
fErrStatus := 9999; {onFilter failed!}
|
|
If InData <> Nil Then
|
|
Begin
|
|
FreeMem(InData, SizeToRead);
|
|
InData := Nil;
|
|
End;
|
|
CloseGracefully;
|
|
End else Result := Len;
|
|
If Filtered = Nil Then Result := 0;
|
|
If Filtered <> Nil Then Move(Filtered^,Buf^,Len);
|
|
If InData <> Nil Then
|
|
Begin
|
|
FreeMem(InData, SizeToRead);
|
|
InData := Nil;
|
|
End;
|
|
feOnFilter(ddFreePointer, Nil, Filtered, Len, Len, Handled, FClientThread);
|
|
End;
|
|
{$ENDIF}
|
|
end;
|
|
fReadTimeout := Result < 1;
|
|
if Result = 0 then CloseGracefully;
|
|
// 7-27 finally
|
|
// 7-27 end;
|
|
end;
|
|
|
|
function TDXSock.Read: Char;
|
|
var
|
|
Size: Integer;
|
|
|
|
begin
|
|
{$IFDEF VER100}
|
|
Size := BlockRead(@Result, 1);
|
|
{$ELSE}
|
|
Size := Read(@Result, 1);
|
|
{$ENDIF}
|
|
if Size < 1 then Result := #0;
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.Read='+Result);
|
|
End;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDXSock.ReadStr(MaxLength: Integer): string;
|
|
var
|
|
Size: Integer;
|
|
|
|
begin
|
|
fReadTimeout := False;
|
|
if Sock = INVALID_SOCKET then Exit;
|
|
if MaxLength < 0 then MaxLength := TDXHugeSize;
|
|
Result:='';
|
|
if MaxLength=0 then Exit; //2.3c
|
|
Setlength(Result, MaxLength);
|
|
FillChar(Result[1],MaxLength,0);
|
|
{$IFDEF VER100}
|
|
Size := BlockRead(@Result[1], MaxLength);
|
|
{$ELSE}
|
|
Size := Read(@Result[1], MaxLength);
|
|
{$ENDIF}
|
|
if (((fErrStatus <> 0) and (fErrStatus <> WSAETIMEDOUT))) or (Size = 0) then Result := ''
|
|
// 3.0
|
|
else if (Size=Socket_Error) then Result:=''
|
|
else Setlength(Result, Size);
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
If Result<>'' then
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.ReadStr='+Result);
|
|
End;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDXSock.ReadString(MaxLength: Integer; Timeout: Longword): string;
|
|
var
|
|
Size: Integer;
|
|
StartTime: Longword;
|
|
|
|
begin
|
|
Result := '';
|
|
fReadTimeout := False;
|
|
if Sock = INVALID_SOCKET then Exit;
|
|
fReadTimeout := False;
|
|
if (MaxLength < 1) or (MaxLength > 250) then Exit; // 2.3
|
|
StartTime := TimeCounter + Timeout;
|
|
fErrStatus := 0;
|
|
while (CountWaiting < MaxLength) and
|
|
(not uRODXString.Timeout(StartTime)) and
|
|
((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT)) do begin
|
|
DoSleepEx(1);
|
|
end;
|
|
if (CountWaiting < MaxLength) then begin
|
|
fReadTimeout := True;
|
|
Exit;
|
|
end;
|
|
Setlength(Result, MaxLength);
|
|
FillChar(Result[1],MaxLength,0);
|
|
{$IFDEF VER100}
|
|
Size := BlockRead(@Result[1], MaxLength);
|
|
{$ELSE}
|
|
Size := Read(@Result[1], MaxLength);
|
|
{$ENDIF}
|
|
if (((fErrStatus <> 0) and (fErrStatus <> WSAETIMEDOUT))) or (Size = 0) then Result := ''
|
|
// 3.0
|
|
else if (Size=Socket_Error) then Result:=''
|
|
else Setlength(Result, Size);
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.ReadString='+Result);
|
|
End;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDXSock.GetChar: Str1;
|
|
var
|
|
Size: Integer;
|
|
|
|
begin
|
|
// 7-27 SetLength(Result, 1);
|
|
Result:=#32;
|
|
{$IFDEF VER100}
|
|
Size := BlockRead(@Result[1], 1);
|
|
{$ELSE}
|
|
Size := Read(@Result[1], 1);
|
|
{$ENDIF}
|
|
case Size of
|
|
0: begin
|
|
CloseNow; // 2.3
|
|
Result := '';
|
|
end;
|
|
1: begin
|
|
end;
|
|
else begin
|
|
if fErrStatus=WSAETIMEDOUT then fReadTimeout := False; // 2.3b
|
|
Result := '';
|
|
end;
|
|
end;
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.GetChar='+Result);
|
|
End;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDXSock.GetByte: Byte;
|
|
var
|
|
L: Str1;
|
|
|
|
begin
|
|
L := GetChar;
|
|
if L = '' then Result := 0
|
|
else Result := Ord(L[1]);
|
|
end;
|
|
|
|
function TDXSock.ReadLn(Timeout: Longword): string;
|
|
var
|
|
markerCR, markerLF: Integer;
|
|
s: string;
|
|
startTime: Longword;
|
|
LastChar: Str1;
|
|
pstring: string;
|
|
|
|
{$IFDEF TLS_EDITION}
|
|
Function TestStack(ts: TMJBLIFO): Boolean;
|
|
Begin
|
|
Result := False;
|
|
If assigned(tStack) Then
|
|
Result := ts.ItemCount > 0
|
|
Else tStack := TMJBLIFO.Create;
|
|
End;
|
|
{$ENDIF}
|
|
|
|
begin
|
|
Result := '';
|
|
fReadTimeout := False;
|
|
if Sock = INVALID_SOCKET then exit;
|
|
{$IFDEF TLS_EDITION}
|
|
If FTLS = True Then
|
|
Begin
|
|
If TestStack(tStack) Then
|
|
Result := tStack.Pop
|
|
Else
|
|
Begin
|
|
pString := ReadStr(-1);
|
|
If pString = '' Then pString := ReadStr(-1);
|
|
// If pString[1] = #0 Then pString := ReadStr(-1);
|
|
If Straggler <> '' Then pString := Straggler + pString;
|
|
{$IFDEF OBJECTS_ONLY}
|
|
tBuf := TBrkApart.Create;
|
|
{$ELSE}
|
|
tBuf := TBrkApart.Create(Nil);
|
|
{$ENDIF}
|
|
tBuf.AllowEmptyString := True;
|
|
tBuf.BaseString := pString;
|
|
tBuf.BreakString := #13#10;
|
|
tBuf.BreakApart;
|
|
MarkerLF := tbuf.StringList.Count - 2; // Allow for last String as CRLF
|
|
For markerCR := MarkerLF Downto 0 Do
|
|
Begin
|
|
tStack.Push(tbuf.StringList.Strings[markerCR]);
|
|
End;
|
|
Straggler := tBuf.Straggler;
|
|
FreeAndNil(tBuf);
|
|
If tStack.ItemCount > 0 Then
|
|
Result := tStack.Pop
|
|
Else
|
|
Result := pString;
|
|
End;
|
|
Exit;
|
|
End;
|
|
{$ENDIF}
|
|
S := GetChar;
|
|
LastChar := S;
|
|
if (Sock = INVALID_SOCKET) {or (fReadTimeout) removed 7-27} then exit;
|
|
MarkerLF := 0;
|
|
MarkerCR := 0;
|
|
fErrStatus := 0;
|
|
StartTime := TimeCounter + Timeout;
|
|
while (Sock <> Invalid_Socket) and
|
|
(MarkerLF + MarkerCR = 0) and
|
|
(not uRODXString.Timeout(StartTime)) and
|
|
(Length(S) < fTooManyCharacters) and
|
|
((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT)
|
|
// 7-27:
|
|
or (fErrStatus = WSAEWOULDBLOCK)) do begin
|
|
If fErrStatus = WSAEWOULDBLOCK then ProcessWindowsMessageQueue;
|
|
if (LastChar = '') or (not (LastChar[1] in [#10, #13])) then begin {handles getchar from above!}
|
|
pString := PeekString;
|
|
if uRODXString.Timeout(StartTime) then Break;
|
|
if (pString = '') then begin
|
|
LastChar := GetChar;
|
|
end
|
|
else begin
|
|
MarkerLF := CharPos(#10, pString);
|
|
MarkerCR := CharPos(#13, pString);
|
|
if MarkerLF + MarkerCR > 0 then begin
|
|
if MarkerLF = 0 then MarkerLF := MarkerCR
|
|
else if MarkerCR = 0 then MarkerCR := MarkerLF;
|
|
if Min(MarkerLF, MarkerCR)>1 then // 2.4
|
|
S := S + Copy(pString, 1, Min(MarkerLF, MarkerCR)-1);
|
|
ReadStr(Min(MarkerLF, MarkerCR));
|
|
LastChar := #13;
|
|
end
|
|
else begin
|
|
S := S + pString;
|
|
ReadStr(Length(pString));
|
|
LastChar := '';
|
|
end;
|
|
end;
|
|
if uRODXString.Timeout(StartTime) then Break;
|
|
if LastChar > '' then begin
|
|
S := S + LastChar;
|
|
end;
|
|
end;
|
|
if (Length(LastChar) > 0) and (LastChar[1] in [#10, #13]) then begin
|
|
MarkerLF := CharPos(#10, S);
|
|
MarkerCR := CharPos(#13, S);
|
|
if MarkerLF + MarkerCR > 0 then begin
|
|
if MarkerLF = Length(S) then begin {unix or DOS}
|
|
if MarkerCR = 0 then begin {unix or Mac}
|
|
if CountWaiting > 0 then
|
|
if PeekChar = #13 then begin {Mac}
|
|
LastChar := GetChar;
|
|
S := S + LastChar;
|
|
end;
|
|
end
|
|
else if MarkerCR < MarkerLF then MarkerLF := MarkerCR;
|
|
MarkerCR := MarkerLF;
|
|
end;
|
|
if MarkerCR = Length(S) then begin {Mac or DOS}
|
|
if MarkerLF = 0 then begin {Mac or DOS}
|
|
if CountWaiting > 0 then
|
|
if PeekChar = #10 then begin {DOS}
|
|
LastChar := GetChar;
|
|
S := S + LastChar;
|
|
end;
|
|
end
|
|
else if MarkerLF < MarkerCR then MarkerCR := MarkerLF;
|
|
MarkerLF := MarkerCR;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
if Sock = INVALID_SOCKET then exit;
|
|
FReadTimeout := (MarkerCR < 1) and (uRODXString.Timeout(StartTime));
|
|
Result := Copy(S, 1, MarkerCR - 1);
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.ReadLn='+Result);
|
|
End;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDXSock.ReadCRLF(Timeout: Longword): string;
|
|
Begin
|
|
Result:=ReadToAnyDelimiter(Timeout,#13#10);
|
|
End;
|
|
{var
|
|
marker: Integer;
|
|
s: string;
|
|
startTime: Longword;
|
|
|
|
begin
|
|
Result := '';
|
|
fReadTimeout := False;
|
|
if Sock = INVALID_SOCKET then exit;
|
|
Marker := 0;
|
|
StartTime := TimeCounter + Timeout;
|
|
fErrStatus := 0;
|
|
while (sock <> Invalid_Socket) and
|
|
(Marker = 0) and
|
|
(not DXString.Timeout(StartTime)) and
|
|
(Length(S) < fTooManyCharacters) and
|
|
((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT)) do begin
|
|
S := S + GetChar;
|
|
Marker := QuickPos(#13#10, S);
|
|
end;
|
|
if Sock = INVALID_SOCKET then exit;
|
|
Result := Copy(S, 1, Marker - 1);
|
|
end;}
|
|
|
|
function TDXSock.ReadToAnyDelimiter(Timeout: Longword;Delimiter:String): string;
|
|
var
|
|
slen: Integer;
|
|
marker: Integer;
|
|
s: string;
|
|
startTime: Longword;
|
|
pString:String;
|
|
iDel:Integer;
|
|
|
|
Begin
|
|
Result := '';
|
|
fReadTimeout := False;
|
|
if Sock = INVALID_SOCKET then exit;
|
|
S := '';
|
|
sLen:=0;
|
|
StartTime := TimeCounter + Timeout;
|
|
Marker:=0;
|
|
while (sock <> Invalid_Socket) and
|
|
(Marker = 0) and
|
|
(not uRODXString.Timeout(StartTime)) and
|
|
(sLen < fTooManyCharacters) and
|
|
((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT)) do begin
|
|
pString := PeekString;
|
|
if pString<>'' then Begin
|
|
sLen:=Length(S);
|
|
S:=S+pString;
|
|
Marker := QuickPos(Delimiter, S);
|
|
If Marker=0 then Begin
|
|
ReadStr(Length(pString)); // clear socket
|
|
End
|
|
Else Begin
|
|
S:=Copy(S,1,Marker-1);
|
|
If Marker<sLen then iDel:=Length(Delimiter)-(sLen-Marker)
|
|
Else iDel:=(Marker-sLen)+Length(Delimiter);
|
|
// If Marker<sLen then iDel:=Length(Delimiter)-(sLen-Marker+1)
|
|
// Else iDel:=Marker-sLen+(Length(Delimiter)-1);
|
|
ReadStr(iDel);
|
|
End;
|
|
End
|
|
Else Begin
|
|
pString:=GetChar;
|
|
if pString='' then DoSleepEx(1)
|
|
Else begin
|
|
Inc(sLen);
|
|
S:=S+pString;
|
|
End;
|
|
End;
|
|
End;
|
|
if Sock = INVALID_SOCKET then exit;
|
|
fReadTimeout:=uRODXString.Timeout(StartTime);
|
|
Result := S; // return what ever is collected, even if not done!
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.ReadToAnyDelimeter='+Result);
|
|
End;
|
|
{$ENDIF}
|
|
End;
|
|
|
|
function TDXSock.ReadNull(Timeout: Longword): string;
|
|
begin
|
|
Result := ReadToAnyDelimiter(Timeout,#0);
|
|
end;
|
|
|
|
function TDXSock.ReadSpace(Timeout: Longword): string;
|
|
begin
|
|
Result := ReadToAnyDelimiter(Timeout,#32);
|
|
end;
|
|
|
|
function TDXSock.SendBuf(const Buf; Count: Integer): Integer; // Borland friendly
|
|
begin
|
|
{$IFDEF VER100}
|
|
Result := BlockWrite(@Buf, Count);
|
|
{$ELSE}
|
|
Result := Write(@Buf, Count);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDXSock.ReceiveBuf(var Buf; Count: Integer): Integer; // Borland friendly
|
|
begin
|
|
{$IFDEF VER100}
|
|
Result := BlockRead(@Buf, Count);
|
|
{$ELSE}
|
|
Result := Read(@Buf, Count);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF VER100}
|
|
function TDXSock.SendFromStream(Stream: TStream): Boolean;
|
|
{$ELSE}
|
|
function TDXSock.SendFrom(Stream: TStream): Boolean;
|
|
{$ENDIF}
|
|
var
|
|
Len: Integer;
|
|
SSize, SPosition: Integer;
|
|
Tries: Integer;
|
|
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.SendFrom');
|
|
End;
|
|
{$ENDIF}
|
|
fErrStatus := 0;
|
|
SSize := Stream.Size;
|
|
SPosition := Stream.Position;
|
|
Tries := 0;
|
|
while (sock <> Invalid_Socket) and
|
|
(Stream.Position < Stream.Size) and
|
|
(fErrStatus = 0) and
|
|
(Tries < 3) do begin
|
|
if (SSize - SPosition) < FActualBlockSize then Len := SSize - SPosition
|
|
else Len := FActualBlockSize;
|
|
if Len > 0 then begin
|
|
Stream.Seek(SPosition, 0);
|
|
Stream.Read(fChunkBuf^, Len);
|
|
{$IFDEF VER100}
|
|
Len := BlockWrite(fChunkBuf, Len);
|
|
{$ELSE}
|
|
Len := Write(fChunkBuf, Len);
|
|
{$ENDIF}
|
|
SPosition := SPosition + Len;
|
|
if fErrStatus > 0 then begin
|
|
Tries := 3;
|
|
end
|
|
else if Len < 1 then Inc(Tries)
|
|
else Tries := 0;
|
|
end;
|
|
end;
|
|
Result := (Sock <> INVALID_SOCKET) and (fErrStatus = 0);
|
|
end;
|
|
|
|
{$IFDEF VER100}
|
|
function TDXSock.SendFromWindowsFile(var Handle: Integer): boolean;
|
|
{$ELSE}
|
|
function TDXSock.SendFrom(var Handle: Integer): boolean;
|
|
{$ENDIF}
|
|
var
|
|
Len: Integer;
|
|
SLen: Integer;
|
|
Offset: Integer;
|
|
FSize: Integer;
|
|
Tries: Integer;
|
|
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.SendFrom');
|
|
End;
|
|
{$ENDIF}
|
|
Result := False;
|
|
fReadTimeout := False;
|
|
if Sock = INVALID_SOCKET then Exit;
|
|
if Handle <> 0 then begin
|
|
Offset := FileSeek(Handle, 0, 1);
|
|
FSize := FileSeek(Handle, 0, 2);
|
|
FileSeek(Handle, Offset, 0);
|
|
fErrStatus := 0;
|
|
Tries := 0;
|
|
while (sock <> Invalid_Socket) and
|
|
(Offset < FSize) and
|
|
(fErrStatus = 0) and
|
|
(Tries < 3) do begin
|
|
if Sock <> INVALID_SOCKET then begin
|
|
Len := FileRead(Handle, fChunkBuf^, FActualBlockSize - 1);
|
|
if Len > 0 then begin
|
|
{$IFDEF VER100}
|
|
SLen := BlockWrite(fChunkBuf, Len);
|
|
{$ELSE}
|
|
SLen := Write(fChunkBuf, Len);
|
|
{$ENDIF}
|
|
if SLen <> Len then begin
|
|
Offset := SLen + Offset;
|
|
FileSeek(Handle, Offset, 0);
|
|
Inc(Tries);
|
|
end
|
|
else Tries := 0;
|
|
if fErrStatus > 0 then Tries := 3;
|
|
end;
|
|
end;
|
|
Offset := FileSeek(Handle, 0, 1);
|
|
end;
|
|
end;
|
|
Result := (Sock <> INVALID_SOCKET) and (fErrStatus = 0);
|
|
end;
|
|
|
|
{$IFDEF VER100}
|
|
function TDXSock.SendFromBorlandFile(var Handle: file): boolean;
|
|
{$ELSE}
|
|
function TDXSock.SendFrom(var Handle: file): boolean;
|
|
{$ENDIF}
|
|
var
|
|
Len: Integer;
|
|
SLen: Integer;
|
|
OffSet: Integer;
|
|
Tries: Integer;
|
|
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.SendFrom');
|
|
End;
|
|
{$ENDIF}
|
|
Result := False;
|
|
fReadTimeout := False;
|
|
if Sock = INVALID_SOCKET then Exit;
|
|
fErrStatus := 0;
|
|
Tries := 0;
|
|
while not Eof(Handle) and (fErrStatus = 0) and (Tries < 3) and (sock <> Invalid_Socket) do begin
|
|
Offset := System.FilePos(Handle);
|
|
if (Sock <> INVALID_SOCKET) then begin
|
|
System.BlockRead(Handle, fChunkBuf^, FActualBlockSize - 1, Len);
|
|
{$IFDEF VER100}
|
|
SLen := BlockWrite(fChunkBuf, Len);
|
|
{$ELSE}
|
|
SLen := Write(fChunkBuf, Len);
|
|
{$ENDIF}
|
|
if SLen = Len then begin
|
|
Tries := 0;
|
|
end
|
|
else begin
|
|
Offset := SLen + Offset;
|
|
System.Seek(Handle, Offset);
|
|
Inc(Tries);
|
|
end;
|
|
if fErrStatus > 0 then Tries := 3;
|
|
end;
|
|
end;
|
|
Result := (Sock <> INVALID_SOCKET) and (fErrStatus = 0);
|
|
end;
|
|
|
|
{$IFDEF VER100}
|
|
function TDXSock.SaveToStream(Stream: TStream; Timeout: Longword): Boolean;
|
|
{$ELSE}
|
|
function TDXSock.SaveTo(Stream: TStream; Timeout: Longword): Boolean;
|
|
{$ENDIF}
|
|
var
|
|
SLen: Integer;
|
|
StartTime: Longword;
|
|
OldSize:Integer;
|
|
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.SaveTo');
|
|
End;
|
|
{$ENDIF}
|
|
OldSize:=Stream.Size;
|
|
fErrStatus := 0;
|
|
fReadTimeout := False;
|
|
StartTime := TimeCounter + Timeout;
|
|
while ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT)) and
|
|
(not uRODXString.Timeout(StartTime)) do begin
|
|
{$IFDEF VER100}
|
|
SLen := BlockRead(fChunkBuf, FActualBlockSize);
|
|
{$ELSE}
|
|
SLen := Read(fChunkBuf, FActualBlockSize);
|
|
{$ENDIF}
|
|
if SLen < 1 then begin
|
|
if SLen = 0 then Break;
|
|
end
|
|
else Stream.Write(fChunkBuf^, SLen);
|
|
If SLen < FActualBlockSize Then Break; //GT for TLS Stops looping until timeout
|
|
end;
|
|
Result := (Sock <> INVALID_SOCKET) and ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT));
|
|
If Result then Result:=Stream.Size<>OldSize;
|
|
end;
|
|
|
|
{$IFDEF VER100}
|
|
function TDXSock.SaveToWindowsFile(var Handle: Integer; Timeout: Longword): boolean;
|
|
{$ELSE}
|
|
function TDXSock.SaveTo(var Handle: Integer; Timeout: Longword): boolean;
|
|
{$ENDIF}
|
|
var
|
|
SLen: Integer;
|
|
{$IFDEF VER100}
|
|
STmp: Integer;
|
|
{$ELSE}
|
|
STmp: Cardinal;
|
|
{$ENDIF}
|
|
StartTime: Longword;
|
|
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.SaveTo');
|
|
End;
|
|
{$ENDIF}
|
|
fErrStatus := 0;
|
|
fReadTimeout := False;
|
|
StartTime := TimeCounter + Timeout;
|
|
while ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT)) and
|
|
(not uRODXString.Timeout(StartTime)) do begin
|
|
{$IFDEF VER100}
|
|
SLen := BlockRead(fChunkBuf, FActualBlockSize);
|
|
{$ELSE}
|
|
SLen := Read(fChunkBuf, FActualBlockSize);
|
|
{$ENDIF}
|
|
STmp := 0;
|
|
if SLen < 1 then begin
|
|
if SLen = 0 then Break;
|
|
end
|
|
else
|
|
WindowsWriteFile(Handle, fChunkBuf^, SLen, STmp);
|
|
end;
|
|
Result := (Sock <> INVALID_SOCKET) and ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT));
|
|
end;
|
|
|
|
{$IFDEF VER100}
|
|
function TDXSock.SaveToBorlandFile(var Handle: file; Timeout: Longword): boolean;
|
|
{$ELSE}
|
|
function TDXSock.SaveTo(var Handle: file; Timeout: Longword): boolean;
|
|
{$ENDIF}
|
|
var
|
|
SLen: Integer;
|
|
StartTime: Longword;
|
|
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.SaveTo');
|
|
End;
|
|
{$ENDIF}
|
|
fErrStatus := 0;
|
|
fReadTimeout := False;
|
|
StartTime := TimeCounter + Timeout;
|
|
while ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT)) and
|
|
(not uRODXString.Timeout(StartTime)) do begin
|
|
{$IFDEF VER100}
|
|
SLen := BlockRead(fChunkBuf, FActualBlockSize);
|
|
{$ELSE}
|
|
SLen := Read(fChunkBuf, FActualBlockSize);
|
|
{$ENDIF}
|
|
if SLen < 1 then begin
|
|
if SLen = 0 then Break;
|
|
end
|
|
else
|
|
System.BlockWrite(Handle, fChunkBuf^, SLen);
|
|
end;
|
|
Result := (Sock <> INVALID_SOCKET) and ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT));
|
|
end;
|
|
|
|
function TDXSock.WriteWithSize(S: string): Boolean;
|
|
var
|
|
Size: Integer;
|
|
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.WriteWithSize('+S+')');
|
|
End;
|
|
{$ENDIF}
|
|
Result := False;
|
|
Size := Length(S);
|
|
size := htonl(size);
|
|
{$IFDEF VER100}
|
|
if BlockWrite(@Size, 4) = 4 then
|
|
Result := BlockWrite(@S[1], Size) = Size;
|
|
{$ELSE}
|
|
if Write(@Size, 4) = 4 then
|
|
Result := Write(@S[1], Size) = Size;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDXSock.ReadWithSize: string; // 2.4 for ASTAIO (no TIMEOUT, just error check)
|
|
var
|
|
Done: Boolean;
|
|
Size: Integer;
|
|
|
|
begin
|
|
Result := '';
|
|
Done := False;
|
|
Size := 0;
|
|
FErrStatus := 0;
|
|
while (not Done) and (Connected) and ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT)) and (Size >= 0) and (Length(Result) <= Size) do begin
|
|
if Size = 0 then begin
|
|
{$IFDEF VER100}
|
|
BlockRead(@Size, 4);
|
|
{$ELSE}
|
|
Read(@Size, 4);
|
|
{$ENDIF}
|
|
If fErrStatus = WSAETIMEDOUT Then Done := True; //gt while not does not work
|
|
size := ntohl(size);
|
|
end
|
|
else begin
|
|
Result := Result + ReadStr(Size-Length(Result));
|
|
Done := Length(Result) = Size;
|
|
end;
|
|
end;
|
|
if ((fErrStatus <> 0) and (fErrStatus <> WSAETIMEDOUT)) or (Size = 0) then Result := ''
|
|
// 3.0
|
|
else if (Size=Socket_Error) then Result:=''
|
|
else Setlength(Result, Size);
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.ReadWithSize='+Result);
|
|
End;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDXSock.SendFromStreamWithSize(Stream: TStream): Boolean;
|
|
var
|
|
Size: Integer;
|
|
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.SendFromStreamWithSize');
|
|
End;
|
|
{$ENDIF}
|
|
Result:=False;
|
|
Size:=Stream.Size;
|
|
if size<1 then Exit;
|
|
size:=htonl(size);
|
|
Stream.Seek(0, 0);
|
|
{$IFDEF VER100}
|
|
if BlockWrite(@Size, 4) = 4 then
|
|
Result := SendFromStream(Stream);
|
|
{$ELSE}
|
|
if Write(@Size, 4) = 4 then
|
|
Result := SendFrom(Stream);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDXSock.SaveToStreamWithSize(Stream: TStream; Timeout: Longword): Boolean;
|
|
var
|
|
Size: Integer;
|
|
StartTime: Longword;
|
|
SLen: Integer;
|
|
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.SaveToStreamWithSize');
|
|
End;
|
|
{$ENDIF}
|
|
Stream.Size := 0;
|
|
fReadTimeout := False;
|
|
{$IFDEF VER100}
|
|
if BlockRead(@Size, 4) = 4 then begin
|
|
{$ELSE}
|
|
if Read(@Size, 4) = 4 then begin
|
|
{$ENDIF}
|
|
size := ntohl(size);
|
|
StartTime := TimeCounter + Timeout;
|
|
fErrStatus := 0;
|
|
while ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT)) and
|
|
(not uRODXString.Timeout(StartTime)) and
|
|
(Size > 0) do begin
|
|
{$IFDEF VER100}
|
|
SLen := BlockRead(fChunkBuf, Min(Size, FActualBlockSize));
|
|
{$ELSE}
|
|
SLen := Read(fChunkBuf, Min(Size, FActualBlockSize));
|
|
{$ENDIF}
|
|
Case SLen of
|
|
-1:Begin // non-fatal
|
|
End;
|
|
0:Break; // fatal
|
|
Else Begin
|
|
Stream.Write(fChunkBuf^, SLen);
|
|
Dec(Size, SLen);
|
|
end;
|
|
End;
|
|
end;
|
|
end;
|
|
Result := (Sock <> INVALID_SOCKET) and ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT)) and
|
|
((Size=0) and (Stream.Size>0)); // 2.3c
|
|
end;
|
|
|
|
function TDXSock.PeekString: string;
|
|
var
|
|
Size: Integer;
|
|
{$IFDEF TLS_EDITION}
|
|
Filtered, InData: Pointer;
|
|
Handled: Boolean;
|
|
NewLen: Integer;
|
|
SizeToRead: Integer;
|
|
S: String;
|
|
StartTime: Longword;
|
|
{$ENDIF}
|
|
|
|
begin
|
|
Result := '';
|
|
{$IFDEF TLS_EDITION}
|
|
indata := Nil;
|
|
{$ENDIF}
|
|
fReadTimeout := False;
|
|
if Sock = INVALID_SOCKET then exit;
|
|
{$IFDEF TLS_EDITION}
|
|
If Assigned(feOnFilter) Then
|
|
Begin
|
|
SizeToRead := 0;
|
|
StartTime := DxString.TimeCounter + 1000;
|
|
While (SizeToRead = 0) And Connected And (Not DXString.Timeout(StartTime)) Do
|
|
Begin
|
|
ioctlsocket(Sock, FIONREAD, Longint(SizeToRead));
|
|
DoSleepEx(1);
|
|
End;
|
|
If SizeToRead = 0 Then Begin Result := ''; Exit; End;
|
|
|
|
GetMem(InData, SizeToRead);
|
|
|
|
If Sock <> Invalid_Socket Then
|
|
FErrStatus := Recv(Sock, Indata^, SizeToRead, 0)
|
|
Else
|
|
FErrStatus := Socket_Error;
|
|
End
|
|
Else
|
|
{$ENDIF}
|
|
FErrStatus := BasicPeek(Sock, FPeekBuffer^, PeekBufferSize);
|
|
if FErrStatus = Socket_Error then begin
|
|
FErrStatus := 0;
|
|
Exit;
|
|
end
|
|
else Size := FErrStatus;
|
|
{$IFDEF TLS_EDITION}
|
|
If Assigned(feOnFilter) Then
|
|
Begin
|
|
Handled := False;
|
|
Filtered := Nil;
|
|
feOnFilter(ddAfterRead, InData, Filtered, SizeToRead, NewLen, Handled, FClientThread);
|
|
If Not Handled Then Begin
|
|
fErrStatus := 9999; {onFilter failed!}
|
|
If Assigned(feOnFilter) Then
|
|
Begin
|
|
feOnFilter(ddFreePointer, Nil, Filtered, NewLen, NewLen, Handled, FClientThread);
|
|
If InData <> Nil Then
|
|
Begin
|
|
FreeMem(InData, SizeToRead);
|
|
InData := Nil;
|
|
End;
|
|
End;
|
|
Exit;
|
|
End;
|
|
If Filtered <> Nil Then
|
|
Begin
|
|
SetLength(S, NewLen);
|
|
Move(TDXBSArray(Filtered^), S[1], NewLen);
|
|
Result := S;
|
|
fReadTimeout := False;
|
|
FErrStatus := 0;
|
|
End Else Result := '';
|
|
If Assigned(feOnFilter) Then
|
|
Begin
|
|
feOnFilter(ddFreePointer, Nil, Filtered, NewLen, NewLen, Handled, FClientThread);
|
|
If InData <> Nil Then
|
|
Begin
|
|
FreeMem(InData, SizeToRead);
|
|
InData := Nil;
|
|
End;
|
|
End;
|
|
End Else
|
|
Begin
|
|
{$ENDIF}
|
|
Setlength(Result, Size);
|
|
If Size>0 then Move(FPeekBuffer^, Result[1], Size); // 3.0
|
|
{$IFDEF TLS_EDITION}
|
|
fReadTimeout := False;
|
|
FErrStatus := 0;
|
|
End;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDXSock.PeekChar: Char;
|
|
begin
|
|
Result := #0;
|
|
fReadTimeout := False;
|
|
if Sock = INVALID_SOCKET then exit;
|
|
FErrStatus := BasicPeek(Sock, FPeekBuffer^, 1);
|
|
// 3.0
|
|
// if FErrStatus = Socket_Error then CloseNow
|
|
// else Result := FPeekBuffer^[0];
|
|
Case fErrStatus of
|
|
0:CloseNow;
|
|
Socket_Error:FErrStatus:=0;
|
|
Else Result:=FPeekBuffer^[0];
|
|
End;
|
|
end;
|
|
|
|
procedure TDXSock.CloseGracefully;
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.CloseGraceFully');
|
|
End;
|
|
{$ENDIF}
|
|
CloseConnection(Sock, True);
|
|
end;
|
|
|
|
procedure TDXSock.Disconnect;
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.Disconnect');
|
|
End;
|
|
{$ENDIF}
|
|
CloseConnection(Sock, True);
|
|
end;
|
|
|
|
procedure TDXSock.CloseNow;
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.CloseNow');
|
|
End;
|
|
{$ENDIF}
|
|
CloseConnection(Sock, False);
|
|
end;
|
|
|
|
function TDXSock.IsValidSocket: Boolean;
|
|
begin
|
|
Result := Sock <> INVALID_SOCKET;
|
|
end;
|
|
|
|
function TDXSock.IsConnected: Boolean;
|
|
begin
|
|
Result := (Sock <> INVALID_SOCKET)
|
|
and ((LastCommandStatus = 0) or (LastCommandStatus = WSAETIMEDOUT));
|
|
if not Result and (CountWaiting > 0) then Result := True;
|
|
end;
|
|
|
|
function TDXSock.IsReadable: Boolean;
|
|
begin
|
|
fReadTimeout := False;
|
|
Result := False;
|
|
if Sock = INVALID_SOCKET then exit;
|
|
Result:=BasicSelect(Sock,True,GlobalTimeout)>0;
|
|
// Global Timout sometimes sets these write - do we do it to be safe:
|
|
SetReceiveTimeout(Sock, TDXXferTimeout, FErrStatus);
|
|
SetSendTimeout(Sock, TDXXferTimeout, FErrStatus);
|
|
fErrStatus := 0;
|
|
end;
|
|
|
|
function TDXSock.IsWritable: Boolean;
|
|
begin
|
|
fReadTimeout := False;
|
|
Result := False;
|
|
if Sock = INVALID_SOCKET then exit;
|
|
Result:=BasicSelect(Sock,False,GlobalTimeout)>0;
|
|
// Global Timout sometimes sets these write - do we do it to be safe:
|
|
SetReceiveTimeout(Sock, TDXXferTimeout, FErrStatus);
|
|
SetSendTimeout(Sock, TDXXferTimeout, FErrStatus);
|
|
fErrStatus := 0;
|
|
end;
|
|
|
|
function TDXSock.DidReadTimeout: Boolean;
|
|
begin
|
|
Result := fReadTimeout;
|
|
end;
|
|
|
|
function TDXSock.GetLocalPort: Integer;
|
|
begin
|
|
Result := 0;
|
|
if Sock = INVALID_SOCKET then exit;
|
|
Result:=uRODXSocket.GetLocalPort(Sock);
|
|
end;
|
|
|
|
function TDXSock.GetLocalIPAddr: string;
|
|
begin
|
|
Result := '';
|
|
if Sock = INVALID_SOCKET then exit;
|
|
Result:=uRODXSocket.GetLocalIPAddr(Sock);
|
|
end;
|
|
|
|
function TDXSock.GetErrorStr: string;
|
|
begin
|
|
result := GetErrorDesc(GetLastError);
|
|
end;
|
|
|
|
procedure TDXSock.WinsockVersion(var WinsockInfo: PWinsockInfo);
|
|
begin
|
|
if not Assigned(WinsockInfo) then Exit;
|
|
if not SocketLayerLoaded then Exit;
|
|
GetSocketVersion(WinsockInfo);
|
|
end;
|
|
|
|
procedure TDXSock.SetNagle(TurnOn: Boolean);
|
|
begin
|
|
uRODXSocket.SetNagle(Sock, TurnOn, FErrStatus);
|
|
end;
|
|
|
|
procedure TDXSock.SetBlocking(TurnOn: Boolean);
|
|
begin
|
|
fUseBlocking := TurnOn;
|
|
uRODXSocket.SetBlocking(Sock, TurnOn, FErrStatus);
|
|
end;
|
|
|
|
function TDXSock.GetErrorDesc(errorCode: Integer): string;
|
|
begin
|
|
Result := uRODXSocket.GetErrorDesc(ErrorCode);
|
|
end;
|
|
|
|
procedure TDXSock.SetfBlockSizeFlags(Value: TDXBlockSizeFlags);
|
|
begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.SetfBlockSizeFlags');
|
|
End;
|
|
{$ENDIF}
|
|
If Assigned(fChunkBuf) then SysFreeMem(fChunkBuf); // ,FActualBlockSize);
|
|
fChunkBuf:=Nil;
|
|
fBlockSizeFlags := Value;
|
|
case FBlockSizeFlags of
|
|
bsfZero: fActualBlockSize := 0;
|
|
bsfRealSmall: fActualBlockSize := 128;
|
|
bsfSmall: fActualBlockSize := 256;
|
|
bsfNormal: fActualBlockSize := 512;
|
|
bsfBigger: fActualBlockSize := 2048;
|
|
bsfBiggest: fActualBlockSize := 4096;
|
|
{bsfHUGE:}
|
|
else fActualBlockSize := TDXHugeSize;
|
|
end;
|
|
If FBlockSizeFlags <> bsfZero then fChunkBuf:=SysGetMem(FActualBlockSize);
|
|
end;
|
|
|
|
function TDXSOCK.CountWaiting: Integer;
|
|
begin
|
|
Result := uRODXSocket.CountWaiting(Sock, FErrStatus);
|
|
if FErrStatus <> 0 then begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
function TDXSOCK.FilterRead(Const InBuf: Pointer; var OutBuf: Pointer; InSize: Integer;xClientThread: TThread): Integer;
|
|
var
|
|
Handled: Boolean;
|
|
|
|
begin
|
|
if InSize > 0 then
|
|
if Assigned(feOnFilter) then begin
|
|
Handled := False;
|
|
Result := 0;
|
|
feOnFilter(ddAfterRead, InBuf, OutBuf, InSize, Result, Handled,xClientThread);
|
|
if not Handled then begin
|
|
fErrStatus := 9999; {onFilter failed!}
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// used by TDXSockClient only!
|
|
procedure TDXSock.SockClientSetGlobal(I:String;P:Integer);
|
|
Begin
|
|
GlobalPeerPort:=P;
|
|
GlobalPeerIPAddress:=I;
|
|
End;
|
|
|
|
// new 3.0 features:
|
|
Function TDXSock.DroppedConnection:Boolean;
|
|
Begin
|
|
Result:=False;
|
|
If IsReadable then
|
|
If CharactersToRead=0 then Begin
|
|
CloseNow; // invalidates the handle
|
|
Result:=True;
|
|
End;
|
|
End;
|
|
|
|
Function TDXSock.WaitForData(timeout:Longint):Boolean;
|
|
Var
|
|
StartTime:Cardinal;
|
|
|
|
Begin
|
|
{$IFDEF CODE_TRACER}
|
|
If Assigned(CodeTracer) then Begin
|
|
CodeTracer.SendMessage(dxctDebug,'TDXSock.WaitForData');
|
|
End;
|
|
{$ENDIF}
|
|
Result:=False;
|
|
StartTime:=Int64(TimeCounter)+timeout;
|
|
While Not uRODXString.TimeOut(StartTime) do Begin
|
|
If DroppedConnection then Begin
|
|
CloseNow;
|
|
Exit;
|
|
End
|
|
Else Begin
|
|
If CharactersToRead>0 then Begin
|
|
Result:=True;
|
|
Exit;
|
|
End
|
|
Else Begin
|
|
ProcessWindowsMessageQueue;
|
|
DoSleepEx(0);
|
|
End;
|
|
End;
|
|
End;
|
|
End;
|
|
|
|
end.
|
|
|