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);
	closesocket(hSocket);
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.
