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

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.