unit Core;

interface

uses
	Winapi.Windows,
	System.SysUtils, System.Classes,
	DClientSocks,
	CoreDataMessages, ENetDataItems;

const
	StartCh = '$';
	StopCh = '#';

type
	TUInt8      = Byte    ; TPUInt8      = ^TUInt8     ;
	TUInt16     = Word    ; TPUInt16     = ^TUInt16    ;
	TUInt32     = LongWord; TPUInt32     = ^TUInt32    ;
	TUInt64     = UInt64  ; TPUInt64     = ^TUInt64    ;
	TUIntNative = Cardinal; TPUIntNative = ^TUIntNative;
	TSInt8      = ShortInt; TPSInt8      = ^TSInt8     ;
	TSInt16     = SmallInt; TPSInt16     = ^TSInt16    ;
	TSInt32     = LongInt ; TPSInt32     = ^TSInt32    ;
	TSInt64     = Int64   ; TPSInt64     = ^Int64      ;
	TSIntNative = Integer ; TPSIntNative = ^TSIntNative;
	TSingle     = Single  ; TPSingle     = ^TSingle    ;
	TDouble     = Double  ; TPDouble     = ^TDouble    ;

type
	TAnsiChar = AnsiChar; TPAnsiChar = ^TAnsiChar;
	TWideChar = WideChar; TPWideChar = ^TWideChar;
	TUCS4Char = UCS4Char; TPUCS4Char = ^TUCS4Char;

type
	TWinErrCode = TUInt32;
	TPWinErrCode = ^TWinErrCode;

type
	TChannelIndex = TUInt32;
const
	ciAll = TChannelIndex(-1);

type
	TRangeCode = TUInt32;
	TPRangeCode = ^TRangeCode;
const
	rcNoChange     = TRangeCode(-1);
	rcUnipolar10   = TRangeCode($30313055); //FourCC('U010');
	rcUnipolar5    = TRangeCode($35303055); //FourCC('U005');
	rcUnipolar2    = TRangeCode($32303055); //FourCC('U002');
	rcUnipolar1    = TRangeCode($31303055); //FourCC('U001');
	rcBipolar24    = TRangeCode($3432E142); //FourCC('B±24');
	rcBipolar20    = TRangeCode($3032E142); //FourCC('B±20');
	rcBipolar12    = TRangeCode($3231E142); //FourCC('B±12');
	rcBipolar10    = TRangeCode($3031E142); //FourCC('B±10');
	rcBipolar5     = TRangeCode($3530E142); //FourCC('B±05');
	rcBipolar2_5   = TRangeCode($BD32E142); //FourCC('B±2½');
	rcBipolar2     = TRangeCode($3230E142); //FourCC('B±02');
	rcBipolar1_25  = TRangeCode($BC31E142); //FourCC('B±1¼');
	rcBipolar1     = TRangeCode($3130E142); //FourCC('B±01');
	rcBipolar_625  = TRangeCode($3835E142); //FourCC('B±58');
	rcBipolar_3125 = TRangeCode($3331E142); //FourCC('B±13');
	//rcCurrent420   = TRangeCode($30323449); //FourCC('I420'); // mA
	rcRangeCode0   = TRangeCode(0);
	rcRangeCode1   = TRangeCode(1);
	rcRangeCode2   = TRangeCode(2);
	rcRangeCode3   = TRangeCode(3);
	rcRangeCode4   = TRangeCode(4);
	rcRangeCode5   = TRangeCode(5);
	rcRangeCode6   = TRangeCode(6);
	rcRangeCode7   = TRangeCode(7);

type
	TCalMode = TUInt32;
	TPCalMode = TPUInt32;
const
	cmRealData	= TCalMode(0);
	cmUnipolarGround	= TCalMode(1);
	cmUnipolarReference	= TCalMode(3);
	cmBipolarGround	= TCalMode(5);
	cmBipolarReference	= TCalMode(7);

const
	DACCt = 4;

type
	TRefClient = class;

	TPumpThread = class(TThread)
	public
		constructor Create(NewOnPump: TNotifyEvent); virtual;
	protected
		OnPump: TNotifyEvent;

		procedure Execute; override;
	end;

	TVClientSock = class(TDClientSock)
	public
		RefClient: TRefClient;
		InBuf2: AnsiString;
		hInBuf2Mutex, hGotDataSem, hSendReceiveMutex, hPacketMutex, hParseDataEvent: THandle;
		PumpThread: TPumpThread;
		PacketBuf: array of AnsiString;
		ADDataBuf: array of TPUInt8;
		hHelloEvent: THandle;

		constructor Create; override;
		destructor Destroy; override;
		procedure ClientSockGotData(Sender: TObject);
		function SendMsg(Msg: TMessageItem): TWinErrCode;
		function SendReceiveMsg(Msg: TMessageItem; Timeout: TUInt32; bParseDI: Boolean = True): TWinErrCode;
		function SendReceiveMsgAndExpectOK(Msg: TMessageItem; Timeout: TUInt32): TWinErrCode;
	protected
		procedure Pump(Sender: TObject); virtual; abstract;
	end;

	TMainVClientSock = class(TVClientSock)
	public
		HelloPacket: AnsiString;
	protected
		procedure Pump(Sender: TObject); override;
	end;

	TContVClientSock = class(TVClientSock)
	public
		HelloSample: TUInt32;
	protected
		procedure Pump(Sender: TObject); override;
	end;

	TRefClient = class
	protected
		ProCheck: TUInt32;
	public
		MainClientSock: TMainVClientSock;
		ContClientSock: TContVClientSock;
		Timeout: TUInt32;
		DACRange: array[0..DACCt-1] of TRangeCode;
		DeviceID: TUInt16;
		Features, FPGAVer, BaseClock: TUInt32;
		Channels: TChannelIndex;
		bADCStreaming: Boolean;
		NeedsReg: TUInt32;
		FirstCh, LastCh, OversampleByte: TSInt32;
		PubCheck: TUInt32;

		constructor Create;
		destructor Destroy; override;
		function ConnectTo(TarHost: AnsiString; TarPort: Word): TWinErrCode;
		function GetNeedsReg: TWinErrCode;
		function VToCounts(Ch: TChannelIndex; V: TDouble; var Counts: TUInt16): TWinErrCode;
		function SendReceiveMsg(Msg: TMessageItem; bParseDI: Boolean = True): TWinErrCode;
		function SendReceiveMsgAndExpectOK(Msg: TMessageItem): TWinErrCode;
		{
		function SendContMsg(Msg: TMessageItem): TWinErrCode;
		function SendReceiveContMsg(Msg: TMessageItem): TWinErrCode;
		function SendReceiveContMsgAndExpectOK(Msg: TMessageItem): TWinErrCode;
		}
	protected
		procedure ParseHelloPacket(HelloPacket: AnsiString);
	end;
	TClientRef = Pointer;

procedure Swap(var A, D: Byte); overload;
procedure Swap(var A, D: Word); overload;
procedure Swap(var A, D: LongWord); overload;
procedure Swap(var A, D: LongInt); overload;
function MotorolaWord(W: Word): Word;
function MotorolaDWord(W: LongWord): LongWord;

function FlipStr(S: AnsiString): AnsiString;
function IntAsStr(I: LongWord): AnsiString;
function StrAsInt(S: AnsiString): LongWord;
function IsHex(S: AnsiString): Boolean;
function NybbleToHex(N: Byte): AnsiChar;
function HexToNybble(Hex: AnsiChar): Byte;
function StrToHex(Text: AnsiString): AnsiString;
function HexToStr(Hex: AnsiString): AnsiString;
function StrToSpacedHex(Text: AnsiString): AnsiString;
function RawCatStrings(Src: array of AnsiString): AnsiString;

function AnsiMessageBox(Text, Caption: AnsiString; uType: UINT): Integer;

type
	TRangeParams = record
		bBipolar: Boolean;
		Span: Double;
	end;

function CalcRangeParams(Range: TRangeCode; out IntoParams: TRangeParams): TWinErrCode;

function NewADDataBuf(ByteSize: TUInt32): TPUInt32;
procedure DisposeADDataBuf(DataBuf: TPUInt32);

function ExpectMsg(MID: TMID; const DataItemTypes: array of TDataItemClass; Msg: TMessageItem): TWinErrCode; overload;
function ExpectMsg(MID: TMID; DataItemType: TDataItemClass; Msg: TMessageItem): TWinErrCode; overload;

function VerifyClientRef(uClientRef: TClientRef): TWinErrCode;

{
var
	bLogging: Boolean = False;
	LogFil: TFileStream = nil;
}



implementation

uses
	//VCL.Clipbrd,
	Winapi.Winsock2,
	DACExports;

function LocalAlloc(uFlags, uBytes: SIZE_T): Pointer; stdcall; external kernel32;

const
	TCP_QUICKACK = 12; // disables delayed ACKs

	ProData = TUInt32($5C81D234);
	PubData = TUInt32($BE4F6552);

procedure Swap(var A, D: Byte); overload;
asm
	mov CL, [EAX]
	xchg CL, [EDX]
	mov [EAX], CL
end;

procedure Swap(var A, D: Word); overload;
asm
	mov CX, [EAX]
	xchg CX, [EDX]
	mov [EAX], CX
end;

procedure Swap(var A, D: LongWord); overload;
asm
	mov ECX, [EAX]
	xchg ECX, [EDX]
	mov [EAX], ECX
end;

procedure Swap(var A, D: LongInt); overload;
asm
	mov ECX, [EAX]
	xchg ECX, [EDX]
	mov [EAX], ECX
end;

{
procedure Swap(var A, D: Pointer); overload;
asm
	mov ECX, [EAX]
	xchg ECX, [EDX]
	mov [EAX], ECX
end;
}

function MotorolaWord(W: Word): Word;
asm
	xchg AL, AH
end;

function MotorolaDWord(W: LongWord): LongWord;
asm
	bswap EAX
end;



function FlipStr(S: AnsiString): AnsiString;
var
	I, L: TSIntNative;

begin
	L := Length(S);
	SetString(Result, nil, L);
	for I := 0 to L-1 do Result[L - I] := S[1 + I];
end;

function IntAsStr(I: LongWord): AnsiString;
begin
	SetString(Result, PAnsiChar(@I), 4);
end;

function StrAsInt(S: AnsiString): LongWord;
begin
	case Length(S) of
		0: Result := 0;
		1: Result := PByte(@S[1])^;
		2: Result := PWord(@S[1])^;
		else Result := PLongWord(@S[1])^; //3 works because non-empty strings are null-terminated
	end;
end;

function IsHex(S: AnsiString): Boolean;
var
	I: Integer;

begin
	Result := False;
	for I := 1 to Length(S) do begin
		if S[I] < '0' then Exit;
		if S[I] > 'F' then Exit;
		if (S[I] > '9') and (S[I] < 'A') then Exit;
	end;
	Result := True;
end;

function NybbleToHex(N: Byte): AnsiChar;
begin
	N := N and $F;
	if N < 10 then
		Result := AnsiChar(Byte('0') + N)
	else
		Result := AnsiChar(Byte('A') - 10 + N)
	;
end;

function HexToNybble(Hex: AnsiChar): Byte;
begin
	case Hex of
	'0'..'9': Result := Byte(Hex) - Byte('0');
	'A'..'F': Result := Byte(Hex) - Byte('A') + 10;
	'a'..'f': Result := Byte(Hex) - Byte('a') + 10;
	else raise Exception.Create('Invalid hex character ' + IntToHex(Ord(Hex), 2) + ' "' + WideString(Hex) + '"');
	end;
end;

function StrToHex(Text: AnsiString): AnsiString;
var
	I: Integer;

begin
	SetString(Result, nil, Length(Text) * 2);
	for I := 1 to Length(Text) do begin
		Result[I * 2 - 1] := NybbleToHex(Byte(Text[I]) shr 4);
		Result[I * 2] := NybbleToHex(Byte(Text[I]));
	end;
end;

function HexToStr(Hex: AnsiString): AnsiString;
var
	I: Integer;

begin
	SetString(Result, nil, Length(Hex) div 2);
	for I := 1 to Length(Result) do
		Result[I] := AnsiChar(HexToNybble(Hex[I * 2]) + HexToNybble(Hex[I * 2 - 1]) shl 4)
	;
end;

function StrToSpacedHex(Text: AnsiString): AnsiString;
var
	I: Integer;

begin
	SetString(Result, nil, Length(Text) * 3);
	for I := 1 to Length(Text) do begin
		Result[I * 3 - 2] := NybbleToHex(Byte(Text[I]) shr 4);
		Result[I * 3 - 1] := NybbleToHex(Byte(Text[I])      );
		Result[I * 3 - 0] := ' ';
	end;
end;

function RawCatStrings(Src: array of AnsiString): AnsiString;
var
	I, L, Size, Count: TSIntNative;
	P: PAnsiChar;
	S: AnsiString;

begin
	Count := Length(Src);
	Size := 0;
	for I := 0 to Count - 1 do Inc(Size, Length(Src[I]));
	SetString(Result, nil, Size);
	P := PAnsiChar(Result);
	for I := 0 to Count - 1 do
	begin
		S := Src[I];
		L := Length(S);
		if L <> 0 then begin
			System.Move(Pointer(S)^, P^, L * SizeOf(AnsiChar));
			Inc(P, L);
		end;
	end;
end;



function AnsiMessageBox(Text, Caption: AnsiString; uType: UINT): Integer;
begin
	Result := MessageBoxA(0, PAnsiChar(Text), PAnsiChar(Caption), uType);
	Text := '';
	Caption := '';
end;



function CalcRangeParams(Range: TRangeCode; out IntoParams: TRangeParams): TWinErrCode;
begin
	with IntoParams do case Range of
		rcUnipolar10  : begin bBipolar := False; Span := 10    ; end;
		rcUnipolar5   : begin bBipolar := False; Span :=  5    ; end;
		rcUnipolar2   : begin bBipolar := False; Span :=  2    ; end;
		rcUnipolar1   : begin bBipolar := False; Span :=  1    ; end;
		rcBipolar24   : begin bBipolar :=  True; Span :=  48   ; end;
		rcBipolar20   : begin bBipolar :=  True; Span :=  40   ; end;
		rcBipolar12   : begin bBipolar :=  True; Span :=  24   ; end;
		rcBipolar10   : begin bBipolar :=  True; Span := 20    ; end;
		rcBipolar5    : begin bBipolar :=  True; Span := 10    ; end;
		rcBipolar2_5  : begin bBipolar :=  True; Span :=  5    ; end;
		rcBipolar2    : begin bBipolar :=  True; Span :=  1    ; end;
		rcBipolar1_25 : begin bBipolar :=  True; Span :=  2.5  ; end;
		rcBipolar1    : begin bBipolar :=  True; Span :=  2    ; end;
		rcBipolar_625 : begin bBipolar :=  True; Span :=  1.25 ; end;
		rcBipolar_3125: begin bBipolar :=  True; Span :=  0.625; end;

		else begin
			Result := ERROR_INVALID_PARAMETER;
			Exit;
		end;
	end;
	Result := ERROR_SUCCESS;
end;



function NewADDataBuf(ByteSize: TUInt32): TPUInt32;
begin
	Result := LocalAlloc(LMEM_FIXED, 4 + ByteSize);
	Result^ := ByteSize;
end;

procedure DisposeADDataBuf(DataBuf: TPUInt32);
begin
	LocalFree(DataBuf);
end;



{
function ExtractPacket(var S: AnsiString; pbRC: PBoolean = nil): AnsiString;
var
	I: TSNative;

begin
	Result := '';
	if Length(S) = 0 then Exit;

	if S[1] <> StartCh then begin
		I := Pos(RawByteString(StartCh), RawByteString(S));
		if I = 0 then Exit;

		S := Copy(S, I, MAXINT);
	end;

	if pbRC <> nil then
		if Copy(S, 2, 2) = 'RC' then begin
			pbRC^ := True;

			//`@
		end
		else begin
			pbRC^ := False;
		end
	;

	I := Pos(RawByteString(StopCh), RawByteString(S));
	if I = 0 then Exit;

	Result := Copy(S, 1, I);
	S := Copy(S, I + 1, MAXINT);
end;
}



function ExpectMsg(MID: TMID; const DataItemTypes: array of TDataItemClass; Msg: TMessageItem): TWinErrCode; overload;
var
	iDI: Integer;

begin
	if Msg.MID <> MID then
		Result := ERROR_BAD_NET_RESP
	else if Msg.DataItemCount <> Length(DataItemTypes) then
		Result := ERROR_BAD_NET_RESP
	else begin
		Result := ERROR_BAD_NET_RESP;
		for iDI := 0 to Msg.DataItemCount-1 do
			if not (Msg.DataItem[iDI] is DataItemTypes[iDI]) then
      begin
        Result := Msg.DataItemCount;
				Exit;
      end;
		;
		Result := ERROR_SUCCESS;
	end;
end;

function ExpectMsg(MID: TMID; DataItemType: TDataItemClass; Msg: TMessageItem): TWinErrCode; overload;
var
	iDI: Integer;

begin
	if Msg.MID <> MID then
		Result := ERROR_BAD_NET_RESP
	else begin
		Result := ERROR_BAD_NET_RESP;
		for iDI := 0 to Msg.DataItemCount-1 do
			if not (Msg.DataItem[iDI] is DataItemType) then
				Exit
		;
		Result := ERROR_SUCCESS;
	end;
end;



function VerifyClientRef(uClientRef: TClientRef): TWinErrCode;
begin
	Result := ERROR_INVALID_HANDLE;
	try
		if uClientRef = nil then Exit;
		with TRefClient(uClientRef) do begin
			if  ProCheck <> ProData then Exit;
			if PubCheck <> PubData then Exit;
		end;
		Result := ERROR_SUCCESS;
	except
		Result := ERROR_INVALID_HANDLE;
	end;
end;



{ TPumpThread }

constructor TPumpThread.Create(NewOnPump: TNotifyEvent);
begin
	OnPump := NewOnPump;

	inherited Create(False);
end;

procedure TPumpThread.Execute;
begin
	OnPump(Self);
end;

{ TVClientSock }

constructor TVClientSock.Create;
begin
	inherited;

	OnGotData := ClientSockGotData;

	hHelloEvent := CreateEvent(nil, True, False, nil);

	hInBuf2Mutex := CreateMutex(nil, False, nil);
	hGotDataSem := CreateSemaphore(nil, 0, $10000, nil);
	hSendReceiveMutex := CreateMutex(nil, False, nil);
	hPacketMutex := CreateMutex(nil, False, nil);

	hParseDataEvent := CreateEvent(nil, False, False, nil);
	PumpThread := TPumpThread.Create(Pump);
end;

destructor TVClientSock.Destroy;

	procedure CloseInvalidateHandle(var H: THandle);
	begin
		CloseHandle(H);
		H := INVALID_HANDLE_VALUE;
	end;

	procedure InvalidateSetCloseEventHandle(var hEvent: THandle);
	var
		hOld: THandle;

	begin
		hOld := hEvent;
		hEvent := INVALID_HANDLE_VALUE;
		SetEvent(hOld);
		CloseHandle(hOld);
	end;

begin
	InvalidateSetCloseEventHandle(hParseDataEvent);
	FreeAndNil(PumpThread);

	CloseInvalidateHandle(hInBuf2Mutex);
	CloseInvalidateHandle(hGotDataSem);
	CloseInvalidateHandle(hSendReceiveMutex);
	CloseInvalidateHandle(hPacketMutex);

	SetLength(PacketBuf, 0);

	InvalidateSetCloseEventHandle(hHelloEvent);

	inherited;
end;

procedure TVClientSock.ClientSockGotData(Sender: TObject);
begin
	WaitForSingleObject(hInBuf2Mutex, INFINITE);
	try
		InBuf2 := InBuf2 + ReceiveStr;
	finally
		ReleaseMutex(hInBuf2Mutex);
	end;
	SetEvent(hParseDataEvent);
end;

function TVClientSock.SendMsg(Msg: TMessageItem): TWinErrCode;
var
	ThisPacket: AnsiString;

begin
	if not bConnected then begin
		Result := ERROR_NOT_CONNECTED;
		Exit;
	end;

	ThisPacket := Msg.SaveToString;

	WaitForSingleObject(hSendReceiveMutex, INFINITE);
	try
		PostSendStr(ThisPacket);
	finally
		ReleaseMutex(hSendReceiveMutex);
	end;

	Result := ERROR_SUCCESS;
end;

function TVClientSock.SendReceiveMsg(Msg: TMessageItem; Timeout: TUInt32; bParseDI: Boolean = True): TWinErrCode;
var
	EndTime, TimeoutLeft: TSIntNative;
	ThisPacket: AnsiString;
	H: Integer;
	ReceiveDIDTable: TDIDTable;

begin
	if not bConnected then begin
		Result := ERROR_NOT_CONNECTED;
		Exit;
	end;

	ThisPacket := Msg.SaveToString;

	Msg.ClearDataItems;

	WaitForSingleObject(hSendReceiveMutex, INFINITE);
	try
		PostSendStr(ThisPacket);

		TimeoutLeft := Timeout;
		EndTime := GetTickCount + Timeout;
		repeat
			if WaitForSingleObject(hGotDataSem, TimeoutLeft) <> WAIT_OBJECT_0 then begin
				if bConnected then
					Result := ERROR_TIMEOUT
				else
					Result := ERROR_NOT_CONNECTED
				;
				Exit;
			end;

			WaitForSingleObject(hPacketMutex, INFINITE);
			try
				H := High(PacketBuf);
				if H < 0 then begin
					ThisPacket := '';
				end
				else begin
					ThisPacket := PacketBuf[0];
					if H > 0 then begin
						PacketBuf[0] := PacketBuf[H]; //For garbage collection.
						Move(PacketBuf[1], PacketBuf[0], H * SizeOf(PacketBuf[0]));
					end;
					SetLength(PacketBuf, H);
				end;
			finally
				ReleaseMutex(hPacketMutex);
			end;

			if ThisPacket <> '' then begin
				Result := ERROR_SUCCESS;
				Break;
			end;

			TimeoutLeft := EndTime - TSIntNative(GetTickCount);
			if TimeoutLeft < 0 then begin
				if bConnected then
					Result := ERROR_TIMEOUT
				else
					Result := ERROR_NOT_CONNECTED
				;
				Exit;
			end;
		until False;
	finally
		ReleaseMutex(hSendReceiveMutex);
	end;

	if bParseDI then
		ReceiveDIDTable := MISODIDTable
	else
		ReceiveDIDTable := nil
	;
	Msg.LoadFromString(ThisPacket, ReceiveDIDTable);
end;

function TVClientSock.SendReceiveMsgAndExpectOK(Msg: TMessageItem; Timeout: TUInt32): TWinErrCode;
var
	DataItemTypes: array of TDataItemClass;
	iDI: Integer;

begin
	SetLength(DataItemTypes, Msg.DataItemCount);
	for iDI := 0 to High(DataItemTypes) do
		DataItemTypes[iDI] := TDataItemClass(Msg.DataItem[iDI].ClassType).OKReplyType
	;

	Result := SendReceiveMsg(Msg, Timeout);
	if Result <> ERROR_SUCCESS then Exit;

	Result := ExpectMsg(MIDReply, DataItemTypes, Msg);

	SetLength(DataItemTypes, 0);
end;

{ TMainVClientSock }

procedure TMainVClientSock.Pump(Sender: TObject);
var
	ThisPacket: AnsiString;
	I: TSIntNative;

begin
	while (hParseDataEvent <> INVALID_HANDLE_VALUE) and (WaitForSingleObject(hParseDataEvent, INFINITE) = WAIT_OBJECT_0) do
		repeat
			WaitForSingleObject(hInBuf2Mutex, INFINITE);
			try
				ThisPacket := ExtractMessageItemStr(InBuf2);
			finally
				ReleaseMutex(hInBuf2Mutex);
			end;
			if ThisPacket = '' then Break;

			if ThisPacket[1] = TAnsiChar(MIDHello) then begin
				RefClient.ParseHelloPacket(ThisPacket);
				SetEvent(hHelloEvent);
			end
			else begin
				WaitForSingleObject(hPacketMutex, INFINITE);
				try
					I := Length(PacketBuf);
					SetLength(PacketBuf, I+1);
					PacketBuf[I] := ThisPacket;
				finally
					ReleaseMutex(hPacketMutex);
				end;
			end;

			{
			WaitForSingleObject(hPacketMutex, INFINITE);
			try
				if ThisPacket[1] = TAnsiChar(MIDHello) then begin
					HelloPacket := ThisPacket;
				end
				else begin
					I := Length(PacketBuf);
					SetLength(PacketBuf, I+1);
					PacketBuf[I] := ThisPacket;
				end;
			finally
				ReleaseMutex(hPacketMutex);
			end;
			}

			ReleaseSemaphore(hGotDataSem, 1, nil);
		until False
	;
end;

{ TContVClientSock }
procedure TContVClientSock.Pump(Sender: TObject);
var
	ThisData: AnsiString;
	I: TSIntNative;
	pThisData: Pointer;
	pThisDataData: TPUInt32;
	bOnce: Boolean;

begin
	bOnce := True;
	while (hParseDataEvent <> INVALID_HANDLE_VALUE) and (WaitForSingleObject(hParseDataEvent, INFINITE) = WAIT_OBJECT_0) do
		repeat
			WaitForSingleObject(hInBuf2Mutex, INFINITE);
			try
				ThisData := InBuf2;
				InBuf2 := '';
			finally
				ReleaseMutex(hInBuf2Mutex);
			end;
			if ThisData = '' then Break;

			if bOnce then begin
				bOnce := False;

				HelloSample := TPUInt32(@ThisData[1])^;
				SetEvent(hHelloEvent);

				ThisData := Copy(ThisData, 5, MAXINT);
				if ThisData = '' then Break;
			end;

			pThisData := NewADDataBuf(Length(ThisData));

			pThisDataData := pThisData;
			Inc(pThisDataData);
			Move(ThisData[1], pThisDataData^, Length(ThisData));

			WaitForSingleObject(hPacketMutex, INFINITE);
			try
				I := Length(ADDataBuf);
				SetLength(ADDataBuf, I+1);
				ADDataBuf[I] := pThisData;
			finally
				ReleaseMutex(hPacketMutex);
			end;

			ReleaseSemaphore(hGotDataSem, 1, nil);
		until False
	;
end;

{ TRefClient }

constructor TRefClient.Create;
var
	iDAC: TUInt32;

begin
	inherited;

	ProCheck := ProData;
	PubCheck := PubData;
	Timeout := 10000;

	//Default assumptions, hopefully corrected by the hello.
	BaseClock := 10000000;
	for iDAC := 0 to DACCt-1 do DACRange[iDAC] := rcBipolar10;

	//I.e. not yet fetched.
	NeedsReg := (1 shl $13) or (1 shl $14) or (1 shl $15);
	FirstCh := -1;
	LastCh := -1;
	OversampleByte := -1;

	bADCStreaming := False; //Not running.

	MainClientSock := TMainVClientSock.Create;
	MainClientSock.RefClient := Self;
	ContClientSock := TContVClientSock.Create;
	ContClientSock.RefClient := Self;
end;

destructor TRefClient.Destroy;
begin
	ProCheck := not ProData;
	PubCheck := not PubData;

	FreeAndNil(MainClientSock);
	FreeAndNil(ContClientSock);

	inherited;
end;

function TRefClient.ConnectTo(TarHost: AnsiString; TarPort: Word): TWinErrCode;
var
	H: array of THandle;
	SockAddr: AnsiString;
	TrueStr: AnsiString;

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

	Result := MainClientSock.ConnectToSockAddr(SockAddr, TarPort);
	if Result <> ERROR_SUCCESS then Exit;

	Result := ContClientSock.ConnectToSockAddr(SockAddr, TarPort+1);
	if Result <> ERROR_SUCCESS then begin
		MainClientSock.Disconnect;
		Exit;
	end;

	TrueStr := #$01;
	setsockopt(MainClientSock.hSocket, IPPROTO_TCP, TCP_NODELAY, PAnsiChar(TrueStr), Length(TrueStr));
	setsockopt(MainClientSock.hSocket, IPPROTO_TCP, TCP_QUICKACK, PAnsiChar(TrueStr), Length(TrueStr));
	TrueStr := '';

	SetLength(H, 2);
	H[0] := MainClientSock.hHelloEvent;
	H[1] := ContClientSock.hHelloEvent;
	if WaitForMultipleObjects(Length(H), PWOHandleArray(@H[0]), True, Timeout) = WAIT_TIMEOUT then begin
		Result := ERROR_BAD_DEV_TYPE;
		MainClientSock.Disconnect;
		ContClientSock.Disconnect;
		Exit;
	end;
end;

function TRefClient.GetNeedsReg: TWinErrCode;
var
	Msg: TMessageItem;
	I: Integer;

begin
	Result := ERROR_SUCCESS;
	if NeedsReg = 0 then Exit;

	Msg := TMessageItem.Create;
	try
		Msg.MID := MIDMixed;
		for I := 0 to 31 do
			if (NeedsReg and (1 shl I)) <> 0 then
				TReadRegDataItem(Msg.AddNewDataItem(TReadRegDataItem)).RegOff := I
		;

		Result := SendReceiveMsgAndExpectOK(Msg);
		if Result <> ERROR_SUCCESS then Exit;

		for I := 0 to Msg.DataItemCount-1 do
			with TReadRegReplyDataItem(Msg.DataItem[I]) do
				case RegOff of
					$13: FirstCh := RegData;
					$14: LastCh := RegData;
					$15: OversampleByte := RegData;
				end
		;
		NeedsReg := 0;
	finally
		Msg.Free;
	end;
end;

function TRefClient.VToCounts(Ch: TChannelIndex; V: TDouble; var Counts: TUInt16): TWinErrCode;
var
	Range: TRangeCode;
	DACRangeParams: TRangeParams;
	Data: Integer;

begin
	Range := DACRange[Ch];
	if Range = rcNoChange then begin
		Result := ERROR_BAD_NET_RESP;
		Exit;
	end;
	Result := CalcRangeParams(Range, DACRangeParams);
	if Result <> ERROR_SUCCESS then Exit;

	Data := Round(V / DACRangeParams.Span * $10000);
	if DACRangeParams.bBipolar then Data := Data + $8000;
	if Data = $10000 then begin
		Data := $FFFF;
	end
	else if (Data < $0000) or (Data > $FFFF) then begin
		Result := ERROR_INVALID_DATA;
		Exit;
	end;

	Counts := Data;
end;

procedure TRefClient.ParseHelloPacket(HelloPacket: AnsiString);
var
	HelloMsg: TMessageItem;
	iDI: Integer;
	DIClass: TDataItemClass;
	DACRange1DI: TDACRange1DataItem;
	RangeParams: TRangeParams;

begin
	HelloMsg := ExtractRegisteredMessageItem(HelloPacket, MISODIDTable);
	for iDI := 0 to HelloMsg.DataItemCount-1 do begin
		DIClass := TDataItemClass(HelloMsg.DataItem[iDI].ClassType);
		if DIClass = TConnectionIDDataItem then begin
			//`@
		end
		else if DIClass = TDACRange1DataItem then begin
			DACRange1DI := TDACRange1DataItem(HelloMsg.DataItem[iDI]);
			if DACRange1DI.Ch >= DACCt then Continue;
			if CalcRangeParams(DACRange1DI.RangeCode, RangeParams) <> ERROR_SUCCESS then Continue;

			DACRange[DACRange1DI.Ch] := DACRange1DI.RangeCode;
		end
		else if DIClass = TDeviceIDDataItem then begin
			DeviceID := TDeviceIDDataItem(HelloMsg.DataItem[iDI]).DeviceID;
		end
		else if DIClass = TFeaturesDataItem then begin
			Features := TFeaturesDataItem(HelloMsg.DataItem[iDI]).Features;
			case (Features shr 4) and 3 of
				0: Channels := 64;
				1: Channels := 128;
				3: Channels := 16;
			end;
		end
		else if DIClass = TFPGAVerDataItem then begin
			FPGAVer := TFPGAVerDataItem(HelloMsg.DataItem[iDI]).Ver;
		end
		else if DIClass = TBaseClockDataItem then begin
			BaseClock := TBaseClockDataItem(HelloMsg.DataItem[iDI]).BaseClock;
		end;
	end;
end;

function TRefClient.SendReceiveMsg(Msg: TMessageItem; bParseDI: Boolean = True): TWinErrCode;
begin
	Result := MainClientSock.SendReceiveMsg(Msg, Timeout, bParseDI);
end;

function TRefClient.SendReceiveMsgAndExpectOK(Msg: TMessageItem): TWinErrCode;
begin
	Result := MainClientSock.SendReceiveMsgAndExpectOK(Msg, Timeout);
end;

{
function TRefClient.SendContMsg(Msg: TMessageItem): TWinErrCode;
begin
	Result := ContClientSock.SendMsg(Msg);
end;

function TRefClient.SendReceiveContMsg(Msg: TMessageItem): TWinErrCode;
begin
	Result := ContClientSock.SendReceiveMsg(Msg, Timeout);
end;

function TRefClient.SendReceiveContMsgAndExpectOK(Msg: TMessageItem): TWinErrCode;
begin
	Result := ContClientSock.SendReceiveMsgAndExpectOK(Msg, Timeout);
end;
}

end.
