修改马敏钊mmz-asio4delphi，使其能在Delphi Xe2 运行示例程序-End

来源：互联网发布：豆瓣知乎都是什么人编辑：程序博客网时间：2024/06/16 21:49

begin
if (Setting) then intval := 1
else intval := 0;
ErrorCode := SetErrorCode(SetSockOpt(Sock, SOL_Socket, SO_Flag, @intval, SizeofInt));
end;

procedure SetSockStatusInt(Sock: TSocket;
SO_Flag: Integer;
Setting: Integer;
var ErrorCode: Integer);
begin
ErrorCode := SetErrorCode(SetSockOpt(Sock, SOL_Socket, SO_Flag, @Setting, SizeofInt));
end;

procedure SetSendBuffer(Sock: TSocket;
WantedSize: Integer;
var ErrorCode: Integer);
begin
ErrorCode := SetErrorCode(setsockopt(Sock, SOL_SOCKET, SO_SNDBUF, @WantedSize, SizeofInt));
end;

function GetReceiveBuffer(Sock: TSocket;
var ErrorCode: Integer): Integer;
begin
Result := GetSockStatusInt(Sock, SO_RCVBUF, ErrorCode);
end;

function GetSendBuffer(Sock: TSocket;
var ErrorCode: Integer): Integer;
begin
Result := GetSockStatusInt(Sock, SO_SNDBUF, ErrorCode);
end;

procedure KillSocket(var Sock: TSocket);
begin
if Sock <> Invalid_Socket then begin
ShutDown(Sock, 2);
{$IFDEF LINUX}
Libc.__close(Sock);
{$ELSE}
CloseSocket(Sock);
{$ENDIF}
Sock := Invalid_Socket;
end;
end;

procedure CloseConnection(var Sock: TSocket;
Gracefully: Boolean);
var
{$IFDEF VER100} // Delphi3 code
Lin: TLinger;
{$ELSE}
Lin: Linger;
{$ENDIF}

begin
if Sock = Invalid_Socket then Exit;
Lin.l_linger := 0;
if Gracefully then begin
Lin.l_onoff := 1; // Not(0);
{$IFDEF LINUX}Libc.
{$ELSE}Winsock.
{$ENDIF}setsockopt(Sock, SOL_SOCKET, SO_LINGER, @lin, Sizeof(Lin));
end
else begin
Lin.l_onoff := 0;
{$IFDEF LINUX}Libc.
{$ELSE}Winsock.
{$ENDIF}setsockopt(Sock, SOL_SOCKET, SO_LINGER, @lin, sizeof(lin)); {DONT 2.0.f}
end;
KillSocket(Sock);
end;

function GetIPAddressByHost(Host: ansistring; Which: Integer): ansistring;
var
HostEnt: PHostEnt;
iAddr: Integer;

begin
HostEnt := gethostbyname(Pansichar(Host));
if Assigned(HostEnt) then begin
if Which <= (HostEnt^.h_length div 4) then begin
Move(PByteArray(HostEnt^.h_addr_list^)[(Which - 1) * 4], iAddr, 4);
Result := inet_ntoa(in_Addr(iAddr));
end
else Result := '';
end
else Result := '';
end;

function GetHostByIPAddress(IPAddress: ansistring): ansistring;
var
HostEnt: PHostEnt;
InAddr: u_long;

begin
IPAddress := FixDottedIp(IPAddress);
InAddr := inet_addr(Pansichar(IPAddress));
HostEnt := gethostbyaddr(@InAddr, Length(IPAddress), AF_INET);
if Assigned(HostEnt) then Result := StrPas(HostEnt^.h_name)
else Result := '';
end;

function ClientConnectToServer(ServerIPAddress: ansistring;
ServerPort: Integer;
UseUDP, UseNAGLE: Boolean;
ResultSockAddr: PSockAddr;
var ErrorCode: Integer): TSocket;
{$IFDEF LINUX}
const
SOCK_dgram = 2;
SOCK_stream = 1;
{$ENDIF}

begin
Result := Invalid_Socket;
if ServerIPAddress = '' then Exit;
ServerIPAddress := FixDottedIp(ServerIPAddress);
Fillchar(ResultSockAddr^, Sizeof(ResultSockAddr^), #0);
ResultSockAddr.sin_family := AF_INET;
ResultSockAddr.sin_port := htons(ServerPort);
if IsNumericansistring(ServerIPAddress) then begin
ResultSockAddr.sin_addr.S_addr := Inet_Addr(Pansichar(ServerIPAddress));
end
else begin
ServerIPAddress := GetIPAddressByHost(ServerIPAddress, 1);
if ServerIPAddress = '' then begin
ErrorCode := WSAEFAULT; // invalid address
Exit;
end;
ResultSockAddr.sin_addr.S_addr := Inet_Addr(Pansichar(ServerIPAddress));
end;
case UseUDP of
True: begin
Result := CreateSocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP, ErrorCode);
Exit;
end;
else begin
Result := CreateSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, ErrorCode);
if (Result <> Invalid_Socket) and (not UseNAGLE) then
SetNAGLE(Result, UseNAGLE, ErrorCode);
end;
end;
if Result = Invalid_Socket then Exit;
SetSendTimeout(Result, 500, ErrorCode);
if Connect(Result, ResultSockAddr^, ConstSizeofTSockAddrIn) = SOCKET_ERROR then begin
ErrorCode := WSAGetLastError;
KillSocket(Result);
end;
end;

function BindAndListen(BindToIPAddress: ansistring;
BindToPort, WinsockQueue: Integer;
UseUDP, UseNAGLE, ConnectionLess: Boolean;
ResultSockAddr: PSockAddr;
var ErrorCode: Integer): TSocket;
{$IFDEF LINUX}
const
SOCK_dgram = 2;
SOCK_stream = 1;
{$ENDIF}

begin
Fillchar(ResultSockAddr^, Sizeof(ResultSockAddr^), #0); // DO ! USE ZEROMEMORY
// SPX: Result:=CreateSocket(AF_IPX,SOCK_STREAM,NSPROTO_SPX,ErrorCode);
// IPX: Result:=CreateSocket(AF_IPX,SOCK_DGRAM,NSPROTO_IPX,ErrorCode);
case UseUDP of
True: Result := CreateSocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP, ErrorCode);
else begin
Result := CreateSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, ErrorCode);
if (Result <> Invalid_Socket) and (not UseNAGLE) then SetNAGLE(Result, UseNAGLE, ErrorCode);
end;
end;
if Result = Invalid_Socket then Exit;
ResultSockAddr.sin_family := AF_INET;
ResultSockAddr.sin_port := htons(BindToPORT);
// 7-27
if (length(BindToIPAddress) < 7) then ResultSockAddr.sin_addr.S_addr := INADDR_ANY
else ResultSockAddr.sin_addr.S_addr := Inet_Addr(Pansichar(BindToIPAddress));
if Bind(Result, ResultSockAddr^, ConstSizeofTSockAddrIn) = Socket_Error then begin
Result := Invalid_Socket;
ErrorCode := WSAGetLastError;
Exit;
end;
// 7-27
if not ConnectionLess then
if Listen(Result, WinsockQueue) = Socket_Error then begin
Result := Invalid_Socket;
ErrorCode := WSAGetLastError;
end;
end;

function IsAcceptWaiting(ListenerSock: TSocket): Boolean;
{$IFNDEF LINUX}
var
SockList: TFDSet;
{$ENDIF}

begin
{$IFDEF LINUX}
Result := BasicSelect(ListenerSock, True, GlobalTimeout) > 0;
{$ELSE}
SockList.fd_count := 1;
SockList.fd_array[0] := ListenerSock;
Result := Select(0, @sockList, nil, nil, @GlobalTimeout) > 0;
{$ENDIF}
end;

function AcceptNewConnect(ListenerSock: TSocket;
ResultAddr: PSockAddr;
ResultAddrlen: PInteger;
var ErrorCode: Integer): TSocket;
begin
Result := {$IFDEF LINUX}Libc.
{$ELSE}Winsock.
{$ENDIF}Accept(ListenerSock,
{$IFDEF VER90}
ResultAddr^, ResultAddrLen^);
{$ELSE}
{$IFDEF LINUX}
ResultAddr, PSocketLength(ResultAddrLen));
{$ELSE}
ResultAddr, ResultAddrLen);
{$ENDIF}
{$ENDIF}
if Result = Invalid_Socket then ErrorCode := WSAGetLastError
else if ResultAddrLen^ = 0 then ErrorCode := WSAEFault
else ErrorCode := 0;
end;

function BasicSend(Sock: TSocket;
var Buf;
Len: Integer;
Flags: Integer;
var ErrorCode: Integer): Integer;
begin
// Result:=Socket_Error;
// ErrorCode:=WSAEINTR;
// While (Result<0) and ((ErrorCode=WSAEINTR) or (ErrorCode=WSAETIMEDOUT)) do Begin
Result := Send(Sock, Buf, Len, Flags);
ErrorCode := SetErrorCode(Result);
// End;
end;

function UDPSend(Sock: TSocket;
var Buf;
Len: Integer;
Flags: Integer;
SendTo: TSockAddr;
SendToSize: Integer;
var ErrorCode: Integer): Integer;
begin
Result := {$IFDEF LINUX}Libc.
{$ELSE}Winsock.
{$ENDIF}SendTo(Sock, Buf, Len, Flags, SendTo, SendToSize);
ErrorCode := SetErrorCode(Result);
end;

function BasicRecv(Sock: TSocket;
var Buf;
Len: Integer;
Flags: Integer;
var ErrorCode: Integer): Integer;
begin
Result := Recv(Sock, Buf, Len, Flags);
ErrorCode := SetErrorCode(Result);
end;

function UDPRecv(Sock: TSocket;
var Buf;
Len: Integer;
Flags: Integer;
var RcvFrom: TSockAddr;
var RcvFromSize: Integer;
var ErrorCode: Integer): Integer;
begin
Result := {$IFDEF LINUX}Libc.recvfrom(Sock, Buf, Len, Flags, @RcvFrom, @RcvFromSize);
{$ELSE}Winsock.recvfrom(Sock, Buf, Len, Flags, RcvFrom, RcvFromSize);
{$ENDIF}
ErrorCode := SetErrorCode(Result);
end;

function BasicPeek(Sock: TSocket;
var Buf;
Len: Integer): Integer;
begin
Result := Recv(Sock, Buf, Len, MSG_PEEK);
end;

function BasicSelect(Sock: TSocket;
CheckRead: Boolean;
Timeout: TTimeVal): Integer;
var
SockList: TFDSet;

begin
{$IFDEF LINUX}
FD_ZERO(SockList);
SockList.fds_bits[0] := Sock;
if CheckRead then
Result := Select(1, @SockList, nil, nil, @Timeout)
else
Result := Select(1, nil, @SockList, nil, @Timeout);
{$ELSE}
SockList.fd_count := 1;
SockList.fd_array[0] := Sock;
if CheckRead then
Result := Select(0, @sockList, nil, nil, @Timeout)
else
Result := Select(0, nil, @sockList, nil, @Timeout)
{$ENDIF}
end;

function CountWaiting(Sock: TSocket; var ErrorCode: Integer): Integer;
{$IFDEF LINUX}
const
FIONREAD = $541B;
{$ENDIF}
var
numWaiting: longint;

begin
Result := 0;
// in linux IOCtl is used to "set" not "get" values.
ErrorCode := SetErrorCode({$IFDEF LINUX}Libc.IOCtl(Sock, FIONREAD, numWaiting));
{$ELSE}Winsock.IOCtlSocket(Sock, FIONREAD, numWaiting));
{$ENDIF}
if ErrorCode = 0 then Result := numWaiting;
end;

function GetAddressCountByIP(IPAddress: ansistring): Integer;
var
HostEnt: PHostEnt;
InAddr: u_long;

begin
IPAddress := FixDottedIp(IPAddress);
InAddr := inet_addr(Pansichar(IPAddress));
HostEnt := gethostbyaddr(@InAddr, Length(IPAddress), AF_INET);
if Assigned(HostEnt) then Result := HostEnt^.h_length div 4
else Result := 0;
end;

function GetAddressCountByHost(Host: ansistring): Integer;
var
HostEnt: PHostEnt;

begin
HostEnt := gethostbyname(Pansichar(Host));
if Assigned(HostEnt) then Result := HostEnt^.h_length div 4
else Result := 0;
end;

function GetLocalHostName: ansistring;
begin
Result := GetHostByIPAddress(
GetIPAddressByHost('localhost', 1));
if Result = '' then Result := 'Localhost';
end;

function GetLocalPort(Sock: TSocket): Integer;
var
addr: TSockAddrIn;
{$IFDEF LINUX}
addrlen: cardinal;
{$ELSE}
addrlen: integer;
{$ENDIF}

begin
addrlen := ConstSizeofTSockAddrIn;
if getsockname(Sock, addr, addrlen) = 0 then Result := ntohs(addr.sin_port)
else Result := 0;
end;

function GetLocalIPAddr(Sock: TSocket): ansistring;
var
addr: TSockAddrIn;
{$IFDEF LINUX}
addrlen: cardinal;
{$ELSE}
addrlen: integer;
{$ENDIF}

begin
addrlen := ConstSizeofTSockAddrIn;
Fillchar(Addr, Sizeof(TSockAddrIn), #0);
getsockname(Sock, addr, addrlen);
Result := inet_ntoa(addr.sin_addr);
end;

procedure GetRemoteSockAddr(Sock: TSocket;
ResultAddr: PSockAddr;
ResultAddrlen: PInteger;
var ErrorCode: Integer);
{$IFDEF LINUX}
var
TmpAddrLen: Cardinal;
{$ENDIF}

begin
{$IFDEF LINUX}
ErrorCode := SetErrorCode(getpeername(Sock, ResultAddr^, TmpAddrlen));
ResultAddrLen^ := TmpAddrLen;
{$ELSE}
ErrorCode := SetErrorCode(getpeername(Sock, ResultAddr^, ResultAddrlen^));
{$ENDIF}
end;

function GetLastError: Integer;
begin
Result := WSAGetLastError;
end;

function GetErrorDesc(errorCode: Integer): ansistring;
begin
// If you compile and get "Undeclared Identified -
// Edit DXSock.DEF - and select a language!
case errorCode of
WSAEINTR: Result := _WSAEINTR;
WSAEBADF: Result := _WSAEBADF;
WSAEACCES: Result := _WSAEACCES;
WSAEFAULT: Result := _WSAEFAULT;
WSAEINVAL: Result := _WSAEINVAL;
WSAEMFILE: Result := _WSAEMFILE;
WSAEWOULDBLOCK: Result := _WSAEWOULDBLOCK;
WSAEINPROGRESS: Result := _WSAEINPROGRESS;
WSAEALREADY: Result := _WSAEALREADY;
WSAENOTSOCK: Result := _WSAENOTSOCK;
WSAEDESTADDRREQ: Result := _WSAEDESTADDRREQ;
WSAEMSGSIZE: Result := _WSAEMSGSIZE;
WSAEPROTOTYPE: Result := _WSAEPROTOTYPE;
WSAENOPROTOOPT: Result := _WSAENOPROTOOPT;
WSAEPROTONOSUPPORT: Result := _WSAEPROTONOSUPPORT;
WSAESOCKTNOSUPPORT: Result := _WSAESOCKTNOSUPPORT;
WSAEOPNOTSUPP: Result := _WSAEOPNOTSUPP;
WSAEPFNOSUPPORT: Result := _WSAEPFNOSUPPORT;
WSAEAFNOSUPPORT: Result := _WSAEAFNOSUPPORT;
WSAEADDRINUSE: Result := _WSAEADDRINUSE;
WSAEADDRNOTAVAIL: Result := _WSAEADDRNOTAVAIL;
WSAENETDOWN: Result := _WSAENETDOWN;
WSAENETUNREACH: Result := _WSAENETUNREACH;
WSAENETRESET: Result := _WSAENETRESET;
WSAECONNABORTED: Result := _WSAECONNABORTED;
WSAECONNRESET: Result := _WSAECONNRESET;
WSAENOBUFS: Result := _WSAENOBUFS;
WSAEISCONN: Result := _WSAEISCONN;
WSAENOTCONN: Result := _WSAENOTCONN;
WSAESHUTDOWN: Result := _WSAESHUTDOWN;
WSAETOOMANYREFS: Result := _WSAETOOMANYREFS;
WSAETIMEDOUT: Result := _WSAETIMEDOUT;
WSAECONNREFUSED: Result := _WSAECONNREFUSED;
WSAELOOP: Result := _WSAELOOP;
WSAENAMETOOLONG: Result := _WSAENAMETOOLONG;
WSAEHOSTDOWN: Result := _WSAEHOSTDOWN;
WSAEHOSTUNREACH: Result := _WSAEHOSTUNREACH;
WSAENOTEMPTY: Result := _WSAENOTEMPTY;
WSAEPROCLIM: Result := _WSAEPROCLIM;
WSAEUSERS: Result := _WSAEUSERS;
WSAEDQUOT: Result := _WSAEDQUOT;
WSAESTALE: Result := _WSAESTALE;
WSAEREMOTE: Result := _WSAEREMOTE;
WSASYSNOTREADY: Result := _WSASYSNOTREADY;
WSAVERNOTSUPPORTED: Result := _WSAVERNOTSUPPORTED;
WSANOTINITIALISED: Result := _WSANOTINITIALISED;
WSAHOST_NOT_FOUND: Result := _WSAHOST_NOT_FOUND;
WSATRY_AGAIN: Result := _WSATRY_AGAIN;
WSANO_RECOVERY: Result := _WSANO_RECOVERY;
WSANO_DATA: Result := _WSANO_DATA;
else Result := _WSAUNKNOWN + ' (' + IntToCommaStr(ErrorCode) + ')';
end;
end;

function ByteSwap4(long: Cardinal): Cardinal;
begin
result := ntohl(long);
end;

function ByteSwap2(short: smallint): smallint;
begin
result := ntohs(short);
end;

function IPIntToIPStr(IPAddr: Integer): ansistring;
var
Ws: ansistring;

begin
Setlength(Ws, 4);
Move(IPAddr, Ws[1], 4);
Result := IntToStr(Ord(Ws[1])) + '.' +
IntToStr(Ord(Ws[2])) + '.' +
IntToStr(Ord(Ws[3])) + '.' +
IntToStr(Ord(Ws[4]));
end;

function IPStrToIPInt(IPAddr: ansistring): Integer;
var
Ws: ansistring;

begin
Setlength(Ws, 4);
Ws[1] := ansichar(StrToInt(FetchByansichar(IPAddr, '.', False)));
Ws[2] := ansichar(StrToInt(FetchByansichar(IPAddr, '.', False)));
Ws[3] := ansichar(StrToInt(FetchByansichar(IPAddr, '.', False)));
Ws[4] := ansichar(StrToInt(FetchByansichar(IPAddr, '.', False)));
Move(Ws[1], Result, 4);
end;

function SocketLayerLoaded: Boolean;
begin
Result := (StartupResult = 999);
end;

procedure GetSocketVersion(WinsockInfo: PWinsockInfo);
begin
{$IFDEF LINUX}
with WinsockInfo^ do begin
Major_Version := 2;
Minor_Version := 0;
Highest_Major_Version := 2;
Highest_Minor_Version := 0;
Move('Linux Socket Layer 2.0', Description, 256);
Move('Ready', SystemStatus, 128);
MaxSockets := 65000;
MaxUDPDatagramSize := 1500;
VendorInfo := 'Brain Patchwork DX, LLC.';
end;
{$ELSE}
with WinsockInfo^ do begin
Major_Version := BYTE(DllData.wVersion);
Minor_Version := BYTE(DllData.wVersion);
Highest_Major_Version := BYTE(DllData.wHighVersion);
Highest_Minor_Version := BYTE(DllData.wHighVersion);
Move(DllData.szDescription, Description, 256);
Move(DllData.szSystemStatus, SystemStatus, 128);
MaxSockets := DllData.iMaxSockets;
MaxUDPDatagramSize := DllData.iMaxUdpDg;
VendorInfo := DllData.lpVendorInfo;
end;
{$ENDIF}
end;

function ntohs(netshort: Word): Word;
begin
Result := {$IFDEF LINUX}Libc.
{$ELSE}Winsock.
{$ENDIF}ntohs(Netshort);
end;

function inet_ntoa(inaddr: in_addr): Pansichar;
begin
Result := {$IFDEF LINUX}Libc.
{$ELSE}Winsock.
{$ENDIF}inet_ntoa(inaddr);
end;

function htonl(Hostlong: Integer): Integer;
begin
Result := {$IFDEF LINUX}Libc.
{$ELSE}Winsock.
{$ENDIF}htonl(Hostlong);
end;

function ntohl(Netlong: Integer): Integer;
begin
Result := {$IFDEF LINUX}Libc.
{$ELSE}Winsock.
{$ENDIF}ntohl(netlong)
end;

////////////////////////////////////////////////////////////////////////////////
{ TSocketClient }

function TAsioClient.Connto(IIP: ansistring; Iport: Word): boolean;
var
lp: TNewConnect;
begin
Result := false;
FHost := IIP;
FPort := Iport;
lp.Port := Iport;
lp.ipAddress := IIP;
lp.UseUDP := false;
lp.UseBlocking := true;
lp.UseNAGLE := true;
Result := Connect(@lp);
end;

constructor TAsioClient.Create;
begin
inherited Create;
Socket := self;
OnCreate;
end;

destructor TAsioClient.Destroy;
begin
OnDestory;
CloseNow;

inherited;
end;

function TAsioClient.GetCanUseSize: integer;
begin
Result := Self.ReceiveLength;
end;

function TAsioClient.GetHead: Integer;
begin
Result := ReadInteger;
end;

function TAsioClient.Getipandport(IConn: TAsioClient): ansistring;
begin
Result := format('%S:%d', [PeerIPAddress, PeerPort]);
end;

procedure TAsioClient.GetObject(IObj: TObject; IClass: TClass);
var
Ltep: pint;
begin
IObj := TClass.Create;
Ltep := Pointer(Iobj);
inc(Ltep);
ReadBuffer(Ltep, Iobj.InstanceSize - 4);
end;

procedure TAsioClient.GetObject(IObj: TObject);
var
Ltep: pint;
begin
Ltep := Pointer(Iobj);
inc(Ltep);
ReadBuffer(Ltep, Iobj.InstanceSize - 4);
end;

function TAsioClient.GetStream(IStream: TStream; IConn: TAsioClient):
integer;
var
LZipMM: TMemoryStream;
LBuff: Pointer;
i, ltot, x: Integer;
begin

LZipMM := TMemoryStream(IStream);
ltot := IConn.ReadInteger;
LZipMM.Size := ltot;
IStream.Position := 0;
LBuff := LZipMM.Memory;
x := 0;
while ltot > 0 do begin
i := ReadBuffer(Pansichar(LBuff) + x, ltot);
Dec(ltot, i);
inc(x, i);
end; // while
// DeCompressStream(LZipMM);
end;

function TAsioClient.GetZipFile(IFileName: ansistring): integer;
var
LZipMM: TMemoryStream;
LBuff: Pointer;
i, ltot, x: Integer;
begin
LZipMM := TMemoryStream.Create;
try
ltot := ReadInteger;
LZipMM.Size := ltot;
LBuff := LZipMM.Memory;
x := 0;
while ltot > 0 do begin
i := ReadBuffer(Pansichar(LBuff) + x, ltot);
Dec(ltot, i);
inc(x, i);
end; // while
DeCompressStream(LZipMM);
LZipMM.SaveToFile(IFileName);
Result := LZipMM.Size;
finally // wrap up
LZipMM.Free;
end; // try/finally
end;

function TAsioClient.GetZipStream(IStream: TStream; IConn: TAsioClient):
integer;
var
LZipMM: TMemoryStream;
LBuff: Pointer;
i, ltot, x: Integer;
begin
LZipMM := TMemoryStream(IStream);
ltot := IConn.ReadInteger;
LZipMM.Size := ltot;
LBuff := LZipMM.Memory;
x := 0;
while ltot > 0 do begin
i := ReadBuffer(Pansichar(LBuff) + x, ltot);
Dec(ltot, i);
inc(x, i);
end; // while
DeCompressStream(LZipMM);
end;

procedure TAsioClient.SendAsioHead(Ilen: integer);
begin
WriteInteger(Ilen);
WriteInteger(Ilen);
end;

procedure TAsioClient.SendHead(ICmd: Integer);
begin
WriteInteger(ICmd);
end;

procedure TAsioClient.SendObject(IObj: TObject);
var
Ltep: Pint;
begin
Ltep := Pointer(IObj);
inc(Ltep);
Write(ltep, IObj.InstanceSize - 4);
end;

procedure TAsioClient.SendZipFile(IFileName: ansistring);
var
LZipMM: TMemoryStream;
begin
LZipMM := TMemoryStream.Create;
try
LZipMM.LoadFromFile(IFileName);
EnCompressStream(LZipMM);
WriteInteger(LZipMM.Size);
WriteBuff(LZipMM.Memory^, LZipMM.Size);
finally
LZipMM.Free;
end;
end;

function TAsioClient.SendZIpStream(IStream: tStream; IConn: TAsioClient;
IisEnc: boolean = false): Integer;
begin
if IisEnc = false then
EnCompressStream(TMemoryStream(IStream));
IConn.WriteInteger(IStream.Size);
IConn.Write(TMemoryStream(IStream).Memory, IStream.Size);
Result := IStream.Size;
end;

procedure TAsioClient.SetConnParam(Ihost: ansistring; Iport: word);
begin
FHost := Ihost;
FPort := Iport;

end;

procedure TAsioClient.WriteBuff(var obj; Ilen: integer);
begin
Write(@obj, Ilen);
end;

procedure TAsioClient.WriteStream(Istream: TStream);
begin
WriteInteger(Istream.Size);
Write(TMemoryStream(Istream).Memory, Istream.Size);
end;

function TDXSock.GetReleaseDate: ansistring;
begin
Result := '2012-02-19';
end;

procedure TDXSock.SetReleaseDate(value: ansistring);
begin
// Absorb!
end;

constructor TDXSock.Create;
begin
inherited Create; // RC2
FReadTimeout := False;
// GetMem (FPeekBuffer,PeekBufferSize) ;
FPeekBuffer := System.GetMemory(PeekBufferSize);
fChunkBuf := nil;
SetFBlockSizeFlags(bsfNormal);
if not SocketLayerLoaded then
ShowMessage('Fatal Socket Error' + '(WSAStartup) ' + GetErrorStr);
fTooManyansicharacters := 2048;
Sock := INVALID_SOCKET;
fbIsUDP := False;
fbIsKeepAlive := False;
fbClientMode := False;
FUseBlocking := True;
GlobalPeerPort := 0;
GlobalPeerIPAddress := '';
// GlobalTimeout.tv_Sec:=0;
// GlobalTimeout.tv_uSec:=1000; // was 10000 4RC2
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
// FreeMem (fChunkBuf,fActualBlockSize);
System.FreeMemory(fChunkBuf);
fChunkBuf := nil;
// FreeMem (FPeekBuffer,PeekBufferSize);
System.FreeMemory(FPeekBuffer);
if Sock <> INVALID_SOCKET then
CloseNow;
inherited Destroy;
end;

function TDXSock.IsConning: Boolean;
begin
Result := IsConnected;
end;

function TDXSock.Writeansistring(const s: ansistring): Integer;
begin
Result := Write(s);
end;

function TDXSock.CloseConn: Boolean;
begin
CloseNow;
Result := True;
end;

procedure TDXSock.SetTimeoutAndBuffer(SocketHandle: Integer);
begin
{$IFDEF CODE_TRACER}
if Assigned(CodeTracer) then begin
CodeTracer.SendMessage(dxctDebug, 'TDXSock.SetTimeoutAndBuffer(' + IntToStr(SocketHandle) + ')');
end;
{$ENDIF}
ResetBufferAndTimeout(SocketHandle, TDXXferTimeout, TDXMaxSocketBuffer);
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}
fTotalWBytes := 0;
fTotalRBytes := 0;
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);
SetBlocking(Sock, UseBlocking, FErrStatus);
fbIsKeepAlive := False;
if not FbIsUDP then begin
SetSockStatusBool(Sock, SO_KeepAlive, True, FErrStatus);
fbIsKeepAlive := FErrStatus = 0;
end;
SetTimeoutAndBuffer(Sock);
// if FbIsUDP then begin
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;
fCPSStart := Now;
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
SetBlocking(Sock, UseBlocking, FErrStatus)
else
Exit;
if not fbIsUDP then begin
SetSockStatusBool(Sock, SO_KeepAlive, True, FErrStatus);
fbIsKeepAlive := fErrStatus = 0;
end;
SetTimeoutAndBuffer(Sock);
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;
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(); // RC2
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;
NewSock.fCPSStart := Now;
// 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 SUPPORT_DESIGNTIME_CLIENTS}

procedure ProcessMessages;
var
MsgRec: TMsg;

begin
if not IsConsole then
if PeekMessage(MsgRec, 0, 0, 0, PM_REMOVE) then begin
TranslateMessage(MsgRec);
DispatchMessage(MsgRec)
end;
end;
{$ENDIF}

{$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
{$IFDEF SUPPORT_DESIGNTIME_CLIENTS}
ProcessMessages;
{$ENDIF}
XferSize := BytesLeft;
if IsWritAble then begin
// DXS4 do not remove this line: it is manditory!
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
WSAETIMEDOUT,
WSAENOBUFS,
WSAEWOULDBLOCK: fErrStatus := 0;
WSAECONNABORTED, WSAECONNRESET: begin
CloseNow;
end;
// else ShowMessageWindow('','unknown fErrStatus='+IntToStr(fErrStatus));
end;
end;
0: begin
// ShowMessageWindow('','ReadError(0) '+IntToStr(fErrStatus));
CloseNow;
end;
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;
end; // Is Write able.
until (BytesLeft = 0) or (FErrStatus <> 0) or (sock = Invalid_Socket);
Result := Len - BytesLeft;
if Result > 0 then
fTotalWBytes := fTotalWBytes + Result;
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: ansichar): Integer;
{$ELSE}

function TDXSock.Write(c: ansichar): 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: ansistring): 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: ansistring): Integer;
var
Len: Integer;
Ws: ansistring;

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: ansistring): 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
{$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
{$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 = WSAETIMEDOUT) or (fErrStatus = WSAEWOULDBLOCK)) then {absorb}
else if Result > 0 then
CodeTracer.SendMessage(dxctDebug, 'TDXSock.Read RECV: ' + Pansichar(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 := Dxansistring.TimeCounter + 120000;
while (SizeToRead = 0) and Connected and (not DXansistring.Timeout(StartTime)) do begin
ioctlsocket(Sock, FIONREAD, Longint(SizeToRead));
DoSleepEx(1);
end;
if SizeToRead <> 0 then begin
InData := nil;
Filtered := nil;
// GetMem (InData,SizeToRead) ;
InData := System.GetMemory(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) ;
System.FreeMemory(InData);
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) ;
System.FreeMemory(InData);
InData := nil;
end;
feOnFilter(ddFreePointer, nil, Filtered, Len, Len, Handled, FClientThread);
end;
{$ENDIF}
end;
fReadTimeout := Result < 1;
if Result = 0 then
CloseGracefully
else if Result > 0 then
fTotalRBytes := fTotalRBytes + Result;
end;

function TDXSock.Read: ansichar;
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): ansistring;
var
Size: Integer;
Ctr: Integer;
Done: Boolean;
ReadSize: Integer;

begin
fReadTimeout := False;
if Sock = INVALID_SOCKET then
Exit;
Result := '';
if MaxLength = 0 then
Exit;
Size := MaxLength;
if MaxLength < 0 then
Size := TDXHugeSize;
Setlength(Result, Size);
fErrStatus := 0;
Ctr := 0;
Done := False;
while (not Done) and (IsConnected) do begin
{$IFDEF VER100}
ReadSize := BlockRead(@Result[Ctr + 1], Size - Ctr);
{$ELSE}
ReadSize := Read(@Result[Ctr + 1], Size - Ctr);
{$ENDIF}
Done := (Ctr + ReadSize = Size) or
((ReadSize = -1) and (MaxLength = -1));
if not Done then begin
if ReadSize > 0 then
Inc(Ctr, ReadSize);
if (ReadSize > 0) and
(MaxLength = -1) and
(CountmyWaiting = 0) then begin
Done := True;
end
else begin
DoSleepEx(1); // allow sockets to digest tcpip.sys packets...
ProcessWindowsMessageQueue;
end;
end
else
fErrStatus := 0;
end;
if (((fErrStatus <> 0) and (fErrStatus <> WSAETIMEDOUT) and (fErrStatus <> WSAEWOULDBLOCK))) or (Size = 0) then
Result := ''
else if (Size = Socket_Error) then
Result := ''
else begin
Setlength(Result, MaxLength);
fReadTimeout := False;
end;
{$IFDEF CODE_TRACER}
if Assigned(CodeTracer) then begin
if Result <> '' then
CodeTracer.SendMessage(dxctDebug, 'TDXSock.ReadStr=' + Result);
end;
{$ENDIF}
end;

function TDXSock.Readansistring(MaxLength: Integer; iTimeout: Longword): ansistring;
var
Size: Integer;
StartTime: Comp;

begin
if (MaxLength < 1) or (MaxLength > 250) then begin // 4RC2
Result := ReadStr(MaxLength);
Exit;
end;
Result := '';
fReadTimeout := False;
if Sock = INVALID_SOCKET then
Exit;
fReadTimeout := False;
StartTime := TimeCounter + iTimeout;
fErrStatus := 0;
while (CountmyWaiting < MaxLength) and
(not Timeout(StartTime)) and
(IsConnected) do begin
DoSleepEx(1);
end;
if (CountmyWaiting < 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) and (fErrStatus <> WSAEWOULDBLOCK))) 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.Readansistring=' + Result);
end;
{$ENDIF}
end;

function TDXSock.Getansichar: 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;
Result := '';
end;
1: begin
end;
else begin
if (fErrStatus = WSAETIMEDOUT) or (fErrStatus = WSAEWOULDBLOCK) then
fReadTimeout := False;
Result := '';
end;
end;
{$IFDEF CODE_TRACER}
if Assigned(CodeTracer) then begin
CodeTracer.SendMessage(dxctDebug, 'TDXSock.Getansichar=' + Result);
end;
{$ENDIF}
end;

function TDXSock.GetByte: Byte;
var
L: Str1;

begin
L := Getansichar;
if L = '' then
Result := 0
else
Result := Ord(L[1]);
end;

function TDXSock.ReadLn(iTimeout: Longword = 100000): ansistring;
var
markerCR, markerLF: Integer;
s: ansistring;
startTime: Comp;
Lastansichar: Str1;
pansistring: ansistring;

{$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
pansistring := ReadStr(-1);
if pansistring = '' then
pansistring := ReadStr(-1);
// If pansistring[1] = #0 Then pansistring := ReadStr(-1);
if Straggler <> '' then
pansistring := Straggler + pansistring;
{$IFDEF OBJECTS_ONLY}
tBuf := TBrkApart.Create;
{$ELSE}
tBuf := TBrkApart.Create(nil);
{$ENDIF}
tBuf.AllowEmptyansistring := True;
tBuf.Baseansistring := pansistring;
tBuf.Breakansistring := #13#10;
tBuf.BreakApart;
MarkerLF := tbuf.ansistringList.Count - 2; // Allow for last ansistring as CRLF
for markerCR := MarkerLF downto 0 do begin
tStack.Push(tbuf.ansistringList.ansistrings[markerCR]);
end;
Straggler := tBuf.Straggler;
FreeAndNil(tBuf);
if tStack.ItemCount > 0 then
Result := tStack.Pop
else
Result := pansistring;
end;
Exit;
end;
{$ENDIF}
S := Getansichar;
Lastansichar := S;
if (Sock = INVALID_SOCKET) {or (fReadTimeout) removed 7-27} then
exit;
MarkerLF := 0;
MarkerCR := 0;
fErrStatus := 0;
StartTime := TimeCounter + iTimeout;
while (Sock <> Invalid_Socket) and
(MarkerLF + MarkerCR = 0) and
(not Timeout(StartTime)) and
(Length(S) < fTooManyansicharacters) and
((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT)
// 7-27:
or (fErrStatus = WSAEWOULDBLOCK)) do begin
if fErrStatus = WSAEWOULDBLOCK then
ProcessWindowsMessageQueue;
if (Lastansichar = '') or (not (Lastansichar[1] in [#10, #13])) then begin {handles getansichar from above!}
pansistring := Peekansistring;
if Timeout(StartTime) then
Break;
if (pansistring = '') then begin
Lastansichar := Getansichar;
end
else begin
MarkerLF := ansicharPos(#10, pansistring);
MarkerCR := ansicharPos(#13, pansistring);
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(pansistring, 1, Min(MarkerLF, MarkerCR) - 1);
ReadStr(Min(MarkerLF, MarkerCR));
Lastansichar := #13;
end
else begin
S := S + pansistring;
ReadStr(Length(pansistring));
Lastansichar := '';
end;
end;
if Timeout(StartTime) then
Break;
if Lastansichar > '' then begin
S := S + Lastansichar;
end;
end;
if (Length(Lastansichar) > 0) and (Lastansichar[1] in [#10, #13]) then begin
MarkerLF := ansicharPos(#10, S);
MarkerCR := ansicharPos(#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 CountmyWaiting > 0 then
if Peekansichar = #13 then begin {Mac}
Lastansichar := Getansichar;
S := S + Lastansichar;
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 CountmyWaiting > 0 then
if Peekansichar = #10 then begin {DOS}
Lastansichar := Getansichar;
S := S + Lastansichar;
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 (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(iTimeout: Longword): ansistring;
begin
Result := ReadToAnyDelimiter(iTimeout, #13#10);
end;
{var
marker: Integer;
s: ansistring;
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 DXansistring.Timeout(StartTime)) and
(Length(S) < fTooManyansicharacters) and
((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT)) do begin
S := S + Getansichar;
Marker := QuickPos(#13#10, S);
end;
if Sock = INVALID_SOCKET then exit;
Result := Copy(S, 1, Marker - 1);
end;}

function TDXSock.ReadToAnyDelimiter(iTimeout: Longword; Delimiter: ansistring):
ansistring;
var
slen: Integer;
marker: Integer;
s: ansistring;
startTime: Comp;
pansistring: ansistring;
iDel: Integer;

begin
Result := '';
fReadTimeout := False;
if Sock = INVALID_SOCKET then
exit;
S := '';
sLen := 0;
StartTime := TimeCounter + iTimeout;
Marker := 0;
while (sock <> Invalid_Socket) and
(Marker = 0) and
(not Timeout(StartTime)) and
(sLen < fTooManyansicharacters) and
((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT) or (fErrStatus = WSAEWOULDBLOCK)) do begin
pansistring := Peekansistring;
if pansistring <> '' then begin
sLen := Length(S);
S := S + pansistring;
Marker := QuickPos(Delimiter, S);
if Marker = 0 then begin
ReadStr(Length(pansistring)); // 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
pansistring := Getansichar;
if pansistring = '' then
DoSleepEx(1)
else begin
Inc(sLen);
S := S + pansistring;
end;
end;
end;
if Sock = INVALID_SOCKET then
exit;
fReadTimeout := 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): ansistring;
begin
Result := ReadToAnyDelimiter(Timeout, #0);
end;

function TDXSock.ReadSpace(Timeout: Longword): ansistring;
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.Readbuffer(iBuf: pointer; Count: Integer): Integer;
var
ltot, i, X: Integer;
begin
Result := -1;
x := 0;
ltot := Count;
while (ltot > 0) and Self.Connected do begin
i := Read(Pansichar(iBuf) + x, ltot);
Dec(ltot, i);
inc(x, i);
end; // while
Result := x;
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;

function TDXSock.SendFrom(Stream: TStream): Boolean;
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.SendFromStreamRange(Stream: TStream; Range: Integer): Boolean;
{$ELSE}

function TDXSock.SendFrom(Stream: TStream; Range: Integer): Boolean;
{$ENDIF}
var
Len: Integer;
SSize, SPosition: Integer;
Tries: Integer;

begin
{$IFDEF CODE_TRACER}
if Assigned(CodeTracer) then begin
CodeTracer.SendMessage(dxctDebug, 'TDXSock.SendFromRange');
end;
{$ENDIF}
fErrStatus := 0;
SSize := Range;
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; iTimeout: Longword): Boolean;
{$ENDIF}
var
SLen: Integer;
StartTime: Comp;
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 + iTimeout;
while ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT) or (fErrStatus = WSAEWOULDBLOCK)) and
(not 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) or (fErrStatus = WSAEWOULDBLOCK));
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; iTimeout: Longword): boolean;
{$ENDIF}
var
SLen: Integer;
{$IFDEF VER100}
STmp: Integer;
{$ELSE}
STmp: Cardinal;
{$ENDIF}
StartTime: Comp;

begin
{$IFDEF CODE_TRACER}
if Assigned(CodeTracer) then begin
CodeTracer.SendMessage(dxctDebug, 'TDXSock.SaveTo');
end;
{$ENDIF}
fErrStatus := 0;
fReadTimeout := False;
StartTime := TimeCounter + iTimeout;
while ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT) or (fErrStatus = WSAEWOULDBLOCK)) and
(not 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) or (fErrStatus = WSAEWOULDBLOCK));
end;

{$IFDEF VER100}

function TDXSock.SaveToBorlandFile(var Handle: file; Timeout: Longword): boolean;
{$ELSE}

function TDXSock.SaveTo(var Handle: file; iTimeout: Longword): boolean;
{$ENDIF}
var
SLen: Integer;
StartTime: Comp;

begin
{$IFDEF CODE_TRACER}
if Assigned(CodeTracer) then begin
CodeTracer.SendMessage(dxctDebug, 'TDXSock.SaveTo');
end;
{$ENDIF}
fErrStatus := 0;
fReadTimeout := False;
StartTime := TimeCounter + iTimeout;
while ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT) or (fErrStatus = WSAEWOULDBLOCK)) and
(not 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) or (fErrStatus = WSAEWOULDBLOCK));
end;

function TDXSock.WriteWithSize(S: ansistring): Boolean;
var
Size, OriginalSize: Integer;
Ws: ansistring;

begin
{$IFDEF CODE_TRACER}
if Assigned(CodeTracer) then begin
CodeTracer.SendMessage(dxctDebug, 'TDXSock.WriteWithSize(' + S + ')');
end;
{$ENDIF}
Result := False;
if S = '' then
Exit;
OriginalSize := Length(S);
SetLength(Ws, OriginalSize + 4);
Move(S[1], Ws[5], OriginalSize);
size := htonl(OriginalSize);
Move(Size, Ws[1], 4);
{$IFDEF VER100}
Result := BlockWrite(@Ws[1], OriginalSize + 4) = OriginalSize + 4;
{$ELSE}
Result := Write(@Ws[1], OriginalSize + 4) = OriginalSize + 4;
{$ENDIF}
end;

function TDXSock.ReadWithSize: ansistring;
var
Done: Boolean;
Size: Integer;

begin
Result := '';
FErrStatus := 0;
// redesigned for non-blocking mode and blocking mode and nagle on/off
Done := False;
while ((fErrStatus = 0) or (fErrStatus = WSAEWOULDBLOCK)) and not Done do begin
Result := Result + Getansichar; // ReadStr(4-Length(Result));
Done := Length(Result) = 4;
end;
if not Done then
Exit;
Move(Result[1], Size, 4);
size := ntohl(size);
if (Size > fTooManyansicharacters) or (Size < 1) then begin
// ShowMessageWindow ('',HexDump (Result) +#13+
// CleanStr (ReadStr (100) ) ) ;
exit;
end;
Result := ReadStr(Size);
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; iTimeout: Longword):
Boolean;
var
Size: Integer;
StartTime: Comp;
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 + iTimeout;
fErrStatus := 0;
while ((fErrStatus = 0) or (fErrStatus = WSAETIMEDOUT) or (fErrStatus = WSAEWOULDBLOCK)) and
(not 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) or (fErrStatus = WSAEWOULDBLOCK)) and
((Size = 0) and (Stream.Size > 0)); // 2.3c
end;

function TDXSock.Peekansistring: ansistring;
var
Size: Integer;
{$IFDEF TLS_EDITION}
Filtered, InData: Pointer;
Handled: Boolean;
NewLen: Integer;
SizeToRead: Integer;
S: ansistring;
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 := Dxansistring.TimeCounter + 1000;
while (SizeToRead = 0) and Connected and (not DXansistring.Timeout(StartTime)) do begin
ioctlsocket(Sock, FIONREAD, Longint(SizeToRead));
DoSleepEx(1);
end;
if SizeToRead = 0 then begin
Result := '';
Exit;
end;

// GetMem (InData,SizeToRead) ;
InData := System.GetMemory(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) ;
System.FreeMemory(InData);
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) ;
System.FreeMemory(InData);
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.Peekansichar: ansichar;
begin
Result := #0;
fReadTimeout := False;
if Sock = INVALID_SOCKET then
exit;
FErrStatus := BasicPeek(Sock, FPeekBuffer^, 1);
case fErrStatus of
0: begin
// ShowMessageWindow('','Peekansichar '+IntToStr(fErrStatus));
CloseNow;
end;
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 ((FErrStatus = 0) or (FErrStatus = WSAETIMEDOUT) or
(FErrStatus = WSAEWOULDBLOCK) or (fErrStatus = 10038));
if not Result and (CountmyWaiting > 0) then
Result := True;
{ If (fErrStatus<>0) and
(fErrStatus<>WSAEWOULDBLOCK) and
(fErrStatus<>WSAETIMEDOUT) and
(fErrStatus<>10038) then ShowMessageWindow('IsConnected',IntToStr(fErrStatus));
If not Result then Begin
If Sock=INVALID_SOCKET then ShowMessageWindow('IsConnected','Invalid_Socket');
End;}
end;

function TDXSock.IsReadable: Boolean;
begin
fReadTimeout := False;
Result := False;
if Sock = INVALID_SOCKET then
exit;
Result := BasicSelect(Sock, True, GlobalTimeout) > 0;
// SetTimeoutAndBuffer(Sock);
fErrStatus := 0;
end;

function TDXSock.IsWritable: Boolean;
begin
fReadTimeout := False;
Result := False;
if Sock = INVALID_SOCKET then
exit;
Result := BasicSelect(Sock, False, GlobalTimeout) > 0;
// SetTimeoutAndBuffer(Sock);
fErrStatus := 0;
end;

function TDXSock.DidReadTimeout: Boolean;
begin
Result := fReadTimeout;
end;

function TDXSock.GetMyLocalPort: Integer;
begin
Result := 0;
if Sock = INVALID_SOCKET then
exit;
Result := GetLocalPort(Sock);
end;

function TDXSock.GetMyLocalIPAddr: ansistring;
begin
Result := '';
if Sock = INVALID_SOCKET then
exit;
Result := GetLocalIPAddr(Sock);
end;

function TDXSock.GetErrorStr: ansistring;
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.SetbNagle(TurnOn: Boolean);
begin
SetNagle(Sock, TurnOn, FErrStatus);
end;

procedure TDXSock.SetbBlocking(TurnOn: Boolean);
begin
fUseBlocking := TurnOn;
SetBlocking(Sock, TurnOn, FErrStatus);
end;

function TDXSock.GetmyErrorDesc(errorCode: Integer): ansistring;
begin
Result := 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
// FreeMem (fChunkBuf,FActualBlockSize);
System.FreeMemory(fChunkBuf);
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: fActualBlockSize := 32768;
else
fActualBlockSize := TDXHugeSize;
end;
if FBlockSizeFlags <> bsfZero then
// GetMem (fChunkBuf,FActualBlockSize) ;
fChunkBuf := System.GetMemory(FActualBlockSize);
end;

function TDXSOCK.CountmyWaiting: Integer;
begin
Result := CountWaiting(Sock, FErrStatus);
if FErrStatus <> 0 then begin
//------------------------------------------------------------------------------
// 抛出异常 2008-2-14 马敏钊
//------------------------------------------------------------------------------
// raise Exception.Create('检查等待数据时发现socket 已断开，抛出异常');

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: ansistring; P: Integer);
begin
GlobalPeerPort := P;
GlobalPeerIPAddress := I;
end;

// new 3.0 features:

function TDXSock.DroppedConnection: Boolean;
begin
Result := False;
if IsReadable then
if ansicharactersToRead = 0 then begin
CloseNow; // invalidates the handle
Result := True;
end;
end;

function TDXSock.WaitForData(itimeout: Longint): Boolean;
var
StartTime: Comp;

begin
{$IFDEF CODE_TRACER}
if Assigned(CodeTracer) then begin
CodeTracer.SendMessage(dxctDebug, 'TDXSock.WaitForData');
end;
{$ENDIF}
Result := False;
StartTime := TimeCounter + Cardinal(itimeout);
while not TimeOut(StartTime) do begin
if DroppedConnection then begin
CloseNow;
Exit;
end
else begin
if ansicharactersToRead > 0 then begin
Result := True;
Exit;
end
else begin
ProcessWindowsMessageQueue;
DoSleepEx(0);
end;
end;
end;
end;

procedure TDXSock.RestartansicharactersPerSecondTimer;
begin
fCPSStart := Now;
fTotalWBytes := 0;
fTotalRBytes := 0;
end;

function TDXSock.ansicharactersPerSecondWritten: Integer;
var
H1, M1, S1, MS1: Word;

begin
try
DecodeTime(Now - fCPSStart, H1, M1, S1, MS1);
Result := fTotalWBytes div Max(((MS1 + (S1 * 1000) + (M1 * 3600000) + (H1 * 216000000)) div 1000), 1);
except
Result := 0;
end;
end;

function TDXSock.ansicharactersPerSecondReceived: Integer;
var
H1, M1, S1, MS1: Word;

begin
try
DecodeTime(Now - fCPSStart, H1, M1, S1, MS1);
Result := fTotalRBytes div Max(((MS1 + (S1 * 1000) + (M1 * 3600000) + (H1 * 216000000)) div 1000), 1);
except
Result := 0;
end;
end;

initialization
{$IFDEF LINUX}
StartupResult := 0;
{$ELSE}
StartupResult := WSAStartup(MAKEBytesToWORD(2, 2), DLLData);
{$ENDIF}
if StartupResult = 0 then begin
StartupResult := 999;
// 6-9: added to load 1 time.
GlobalTimeout.tv_Sec := 0;
GlobalTimeout.tv_uSec := 500; //2500;
end
else StartupResult := 123;

finalization
{$IFNDEF LINUX}
if StartupResult = 999 then WSACleanup;
{$ENDIF}

end.