unit DClientSocks;

interface

uses
	Winapi.Windows,
	System.SysUtils, System.Classes, Winapi.WinSock2, Winapi.IpExport, Winapi.ShellAPI;

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;
		function ConnectToSockAddr(SockAddr: 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 SockAddrFromHost(N: AnsiString): AnsiString;





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 SockAddrFromHost(N: AnsiString): AnsiString;
var
	pHost: PHostEnt;
	IPv4Addr: TSockAddrIn;
	IPv6Addr: SockAddr_In6;
	IPv6AddrAddr: AnsiString;
	L: Integer;

begin
	Result := '';
	ZeroMemory(@IPv4Addr, SizeOf(IPv4Addr));
	ZeroMemory(@IPv6Addr, SizeOf(IPv6Addr));
	IPv4Addr.sin_family := AF_INET;
	IPv6Addr.sin6_family := AF_INET6;

	L := SizeOf(IPv4Addr);
	if WSAStringToAddressA(PAnsiChar(N), AF_INET, nil, PSockAddr(@IPv4Addr)^, L) = 0 then begin
		SetString(Result, PAnsiChar(@IPv4Addr), SizeOf(IPv4Addr));
		Exit;
	end;

	L := SizeOf(IPv6Addr);
	if WSAStringToAddressA(PAnsiChar(N), AF_INET6, nil, PSockAddr(@IPv6Addr)^, L) = 0 then begin
		SetString(Result, PAnsiChar(@IPv6Addr), SizeOf(IPv6Addr));
		Exit;
	end;

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

	if pHost.h_addrtype = AF_INET then begin
		if PLongWord(pHost.h_addr_list^)^ = 0 then Exit;
		if PLongWord(pHost.h_addr_list^)^ = INADDR_NONE then Exit;

		ZeroMemory(@IPv4Addr, SizeOf(IPv4Addr));
		IPv4Addr.sin_family := AF_INET;

		IPv4Addr.sin_addr.S_addr := PLongWord(pHost.h_addr_list^)^;

		SetString(Result, PAnsiChar(@IPv4Addr), SizeOf(IPv4Addr));
	end
	else if pHost.h_addrtype = AF_INET6 then begin
		SetString(IPv6AddrAddr, pHost.h_addr_list^, 16);
		if IPv6AddrAddr = #$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00 then Exit;
		if IPv6AddrAddr = #$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF#$FF then Exit;

		ZeroMemory(@IPv6Addr, SizeOf(IPv6Addr));
		IPv6Addr.sin6_family := AF_INET6;

		Move(IPv6AddrAddr[1], IPv6Addr.sin6_addr.Byte[0], Length(IPv6AddrAddr));

		SetString(Result, PAnsiChar(@IPv6Addr), SizeOf(IPv6Addr));
	end;
end;

{ TDClientSock }

function TDClientSock.ConnectTo(TarHost: AnsiString; TarPort: Word): LongWord;
var
	SockAddr: AnsiString;

begin
	SockAddr := SockAddrFromHost(TarHost);
	if SockAddr = '' then begin
		Result := ERROR_INVALID_NETNAME;
		Exit;
	end;

	Result := ConnectToSockAddr(SockAddr, TarPort);
end;

function TDClientSock.ConnectToSockAddr(SockAddr: AnsiString; TarPort: Word): LongWord;
var
	SyncEvent: TNotifyEvent;
	bSucc: Boolean;
	//ErrStr: String;
	AF: ADDRESS_FAMILY;

begin
	if Length(SockAddr) = SizeOf(TSockAddrIn) then
		AF := AF_INET
	else if Length(SockAddr) = SizeOf(SockAddr_In6) then
		AF := AF_INET6
	else begin
		Result := ERROR_INVALID_NETNAME;
		Exit;
	end;

	hSocket := socket(AF, SOCK_STREAM, IPPROTO_TCP);
	if hSocket = INVALID_SOCKET then begin
		Result := ERROR_NO_NETWORK;
		Exit;
	end;

	PWord(@SockAddr[3])^ := MotorolaWord(TarPort);
	bSucc := connect(hSocket, PSockAddr(PAnsiChar(SockAddr))^, Length(SockAddr)) = 0;
	SockAddr := '';
	if not bSucc then begin
		{
		ErrStr := IntToStr(WSAGetLastError);
		MessageBox(0, PChar(ErrStr), 'Connect Error', MB_ICONEXCLAMATION);
		ErrStr := '';
		}
		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.
