unit DClientSocks;

interface

uses
  Windows,
  SysUtils, Classes, WinSock;

type
  TDClientSock = class;
  TDClientReadThread = class;
  TDClientWriteThread = class;

  TDClientSock = class
  protected
    hSocket: TSocket;
    InBuf: AnsiString;
    hInBufMutex, hSendMutex, hSendSem: THandle;
    ReadThread: TDClientReadThread;
    WriteThread: TDClientWriteThread;
    PostedSend: array of AnsiString;
  public
    bConnected: Boolean;
    OnConnect, OnGotData, OnDisconnect: TNotifyEvent;
    RecSend: array of AnsiString;
    NextRec: Integer;
    bSaveToRec: Boolean;
    constructor Create; virtual;
    destructor Destroy; override;
    function ConnectTo(TarHost: AnsiString; TarPort: Word): LongWord;
    procedure Disconnect;
    procedure PostSendStr(Buf: AnsiString);
    function GetPostedSend: AnsiString;
    function ReceiveStr: AnsiString;
  end;

  TDClientThread = class(TThread)
  protected
    MyClient: TDClientSock;
    //constructor CreateForClientAndGo(NewClient: TDClientSock); virtual;
  end;

  TDClientReadThread = class(TDClientThread)
  protected
    procedure Execute; override;
  end;

  TDClientWriteThread = class(TDClientThread)
  protected
    procedure Execute; override;
  end;

function HostToIP(N: AnsiString): LongWord;





implementation

const
  SD_BOTH = 2;

var
  WSAData: TWSAData;

function MotorolaWord(W: Word): Word;
//asm
//  xchg AL, AH
begin
  Result := (W shr 8) or (W shl 8);
end;

function HostToIP(N: AnsiString): LongWord;
var
  pHost: PHostEnt;

begin
  Result := inet_addr(PAnsiChar(N));
  if Result <> INADDR_NONE then Exit;

  pHost := gethostbyname(PAnsiChar(N));
  if pHost = nil then Exit;

  Result := PLongWord(pHost.h_addr_list^)^;
  if Result = 0 then Result := INADDR_NONE;
end;

{ TDClientSock }

function TDClientSock.ConnectTo(TarHost: AnsiString; TarPort: Word): LongWord;
var
  IPAddr: TSockAddrIn;
  SyncEvent: TNotifyEvent;

begin
  hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if hSocket = INVALID_SOCKET then begin
    Result := ERROR_NO_NETWORK;
    Exit;
  end;
  IPAddr.sin_family := AF_INET;
  IPAddr.sin_port := MotorolaWord(TarPort);
  IPAddr.sin_addr.S_addr := HostToIP(TarHost);
  if connect(hSocket, IPAddr, SizeOf(IPAddr)) <> 0 then begin
    closesocket(hSocket);
    Result := ERROR_NO_NET_OR_BAD_PATH;
    Exit;
  end;

  Result := ERROR_SUCCESS;

  bConnected := True;

  ReadThread := TDClientReadThread.Create(True);
  ReadThread.MyClient := Self;
  ReadThread.Start;
  WriteThread := TDClientWriteThread.Create(True);
  WriteThread.MyClient := Self;
  WriteThread.Start;

  SyncEvent := OnConnect;
  if Assigned(SyncEvent) then try SyncEvent(Self); except end; //Synchronize(DoClientEvent);
end;

constructor TDClientSock.Create;
begin
  InBuf := '';
  bSaveToRec := True;
  hInBufMutex := CreateMutex(nil, False, nil);
  hSendMutex := CreateMutex(nil, False, nil);
  hSendSem := CreateSemaphore(nil, 0, $0FFFFFFF, nil);
end;

destructor TDClientSock.Destroy;
begin
  Disconnect;

  FreeAndNil(ReadThread);
  FreeAndNil(WriteThread);

  CloseHandle(hInBufMutex);
  CloseHandle(hSendMutex);
  CloseHandle(hSendSem);

  inherited; 
end;

procedure TDClientSock.Disconnect;
begin
  shutdown(hSocket, SD_BOTH);
end;

function TDClientSock.GetPostedSend: AnsiString;
var
  L: Integer;

begin
  WaitForSingleObject(hSendSem, INFINITE);
  WaitForSingleObject(hSendMutex, INFINITE);
    L := Length(PostedSend);
    if L = 0 then begin
      Result := '';
    end
    else begin
      Result := PostedSend[0];
      Dec(L);
      PostedSend[0] := PostedSend[L]; //For the garbage collection.
      Move(PostedSend[1], PostedSend[0], L * 4);
      SetLength(PostedSend, L);
    end;
  ReleaseMutex(hSendMutex);
end;

procedure TDClientSock.PostSendStr(Buf: AnsiString);
var
  I: Integer;

begin
  if Length(Buf) = 0 then Exit; //We aren't datagrammy, don't bother with transport packets.

  WaitForSingleObject(hSendMutex, INFINITE);
    I := Length(PostedSend);
    SetLength(PostedSend, I + 1);
    PostedSend[I] := Buf;
  ReleaseMutex(hSendMutex);
  ReleaseSemaphore(hSendSem, 1, nil);
end;

function TDClientSock.ReceiveStr: AnsiString;
begin
  WaitForSingleObject(hInBufMutex, INFINITE);
    Result := InBuf;
    InBuf := '';
  ReleaseMutex(hInBufMutex);
end;

(*
{ TDClientThread }

constructor TDClientThread.CreateForClientAndGo(NewClient: TDClientSock);
begin
  inherited Create(True);
  MyClient := NewClient;
  Start;
end;
*)

{ TDClientReadThread }

procedure TDClientReadThread.Execute;
const
  BufBlockSize = 65536;
  
var
  Buf: AnsiString;
  L: Integer;
  SyncEvent: TNotifyEvent;

begin
  with MyClient do begin
    try
      repeat
        SetString(Buf, nil, BufBlockSize);
        L := recv(hSocket, Buf[1], Length(Buf), 0);
        if L <= 0 then begin
          ReturnValue := ERROR_NOT_CONNECTED;
          Break;
        end;
        if L < BufBlockSize then SetLength(Buf, L);
        WaitForSingleObject(hInBufMutex, INFINITE);
          InBuf := InBuf + Buf;
        ReleaseMutex(hInBufMutex);

        SyncEvent := MyClient.OnGotData;
        if Assigned(SyncEvent) then try SyncEvent(MyClient); except end; //Synchronize(DoClientEvent);
      until False;
    except
    end;

    bConnected := False;

    ReleaseSemaphore(hSendSem, 1, nil);

    shutdown(hSocket, SD_BOTH);
    closesocket(hSocket);

    SyncEvent := MyClient.OnDisconnect;
    if Assigned(SyncEvent) then try SyncEvent(MyClient); except end; //Synchronize(DoClientEvent);
  end;
end;

{ TDClientWriteThread }

procedure TDClientWriteThread.Execute;
var
  Buf: AnsiString;
  L: Integer;

begin
  with MyClient do begin
    try
      repeat
        Buf := GetPostedSend;
        if Length(Buf) = 0 then begin
          ReturnValue := ERROR_CANCELLED;
          Break;
        end;

        L := send(hSocket, Buf[1], Length(Buf), 0);
        if L <= 0 then begin
          ReturnValue := ERROR_NOT_CONNECTED;
          Break;
        end;
      until False;
    except
    end;

    shutdown(hSocket, SD_BOTH);
  end;
end;





initialization
  WSAStartup($2, WSAData);

finalization
  WSACleanup;
end.