Archivado/Componentes.Terceros.RemObjects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
e4d0fcb01d
Componentes.Terceros.RemObj.../internal/5.0.24.615/1/RemObjects SDK for Delphi/Source/RODX/uRODXSock.pas

1885 lines
55 KiB
ObjectPascal
Raw Blame History

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.
Reference in New Issue View Git Blame Copy Permalink