unit CoreExports;

interface

uses
	Winapi.Windows,
	Core;

//System(nil) functions.
function ConnectA(Host: TPAnsiChar; Index: TSInt32): TClientRef; cdecl;
function ConnectW(Host: TPWideChar; Index: TSInt32): TClientRef; cdecl;
function ConnectU(Host: TPUCS4Char; Index: TSInt32): TClientRef; cdecl;
//headers overload ConnectA, ConnectW, ConnectU as Connect
function Disconnect(uClientRef: TClientRef): TWinErrCode; cdecl;

function SetTimeout(uClientRef: TClientRef; TimeoutMS: TSInt32): TWinErrCode; cdecl;

function ChangeDeviceHostnameA(uClientRef: TClientRef; NewHostname: TPAnsiChar): TWinErrCode; cdecl;
function ChangeDeviceHostnameW(uClientRef: TClientRef; NewHostname: TPWideChar): TWinErrCode; cdecl;
function ChangeDeviceHostnameU(uClientRef: TClientRef; NewHostname: TPUCS4Char): TWinErrCode; cdecl;
//headers overload ChangeDeviceHostnameA, ChangeDeviceHostnameU, ChangeDeviceHostnameU as ChangeDeviceHostname

function ScanForDevicesA(NameListChAvailable: TUInt32; pNameList: TPAnsiChar; out NameListCh: TUInt32): TWinErrCode; cdecl;
function ScanForDevicesW(NameListChAvailable: TUInt32; pNameList: TPWideChar; out NameListCh: TUInt32): TWinErrCode; cdecl;
function ScanForDevicesU(NameListChAvailable: TUInt32; pNameList: TPUCS4Char; out NameListCh: TUInt32): TWinErrCode; cdecl;
//function DetectDeviceIPsA(Flags: LongWord; Milliseconds: Double; pIntoBuf: TPAnsiChar; BufSize: LongWord; pNeededBufSize: PLongWord): TWinErrCode; cdecl;
//function UploadFirmwareFile(uClientRef: TClientRef; pFirmwareFilePath: TPAnsiChar): TWinErrCode; cdecl;

function GetDeviceFeatures(uClientRef: TClientRef; FeatureBytes: TUInt32; pFeatures: TPUInt8): TWinErrCode; cdecl;

//Debug(Deb) functions.
function Deb_SendReceiveDI(uClientRef: TClientRef; SendDID: TUInt16; SendPayloadBytes: TUInt32; pSendPayload: TPUInt8; pReceiveDID: TPUInt16; pReceivePayloadBytes: TPUInt32; pReceivePayload: TPUInt8): TWinErrCode; cdecl;

//function Deb_StrToStrA(uClientRef: TClientRef; pSendPacketChars: PLongInt; pSendPacket: TPAnsiChar; pReplyPacketChars: PLongInt; pReplyPacket: TPAnsiChar): TWinErrCode; cdecl;
//function Deb_StrToStrW(uClientRef: TClientRef; pSendPacketChars: PLongInt; pSendPacket: TPWideChar; pReplyPacketChars: PLongInt; pReplyPacket: TPWideChar): TWinErrCode; cdecl;
//function Deb_StrToStrU(uClientRef: TClientRef; pSendPacketChars: PLongInt; pSendPacket: TPUCS4Char; pReplyPacketChars: PLongInt; pReplyPacket: TPUCS4Char): TWinErrCode; cdecl;
//headers overload Deb_StrToStrA, Deb_StrToStrW, Deb_StrToStrU as Deb_StrToStr

function Deb_LogEnable: LongBool; cdecl;





implementation

uses
	System.Math, System.SysUtils, System.Classes, Winapi.Iptypes, Winapi.IpHlpApi, Winapi.WinSock, IdGlobal, IdSocketHandle, IdUDPServer,
	DNS, MDNS, DNSSD,
	CoreDataMessages, ENetDataItems;

type
	TUCS4Chars = array of TUCS4Char;

	TDNSQueryManager = class
	public
		constructor Create;
		destructor Destroy; override;
	public
		procedure Include(NewName: AnsiString); virtual;
		function GetBuffer: AnsiString;
	public
		SizeLeft: TUIntNative;
		hStopQueryEvent: THandle;
	protected
		Name: array of AnsiString;
	end;

function HostnameUToStr(pCh: TPUCS4Char): AnsiString;
begin
	SetLastError(ERROR_SUCCESS);
	Result := '';
	try
		while pCh^ <> 0 do begin
			case pCh^ of
				Byte('A')..Byte('Z'): Result := Result + TAnsiChar(pCh^ + (Byte('a') - Byte('A')));
				Byte('a')..Byte('z'),
				Byte('0')..Byte('9'),
				Byte('.'), Byte('-'):
					Result := Result + TAnsiChar(pCh^);
				else begin
					SetLastError(ERROR_NO_NET_OR_BAD_PATH);
					Exit;
				end;
			end;
			Inc(pCh);
		end;
	except
		SetLastError(ERROR_NOACCESS);
		Exit;
	end;
end;

function HostnameStrToU(Hostname: AnsiString): TUCS4Chars;
var
	iCh: Integer;

begin
	SetLastError(ERROR_SUCCESS);
	SetLength(Result, Length(Hostname));
	try
		for iCh := 0 to High(Result) do
			case Hostname[1+iCh] of
				'A'..'Z': Result[iCh] := TUCS4Char(Byte(Hostname[1+iCh]) + (Byte('a') - Byte('A')));
				'a'..'z',
				'0'..'9',
				'.', '-':
					Result[iCh] := TUCS4Char(Byte(Hostname[1+iCh]));
				else begin
					SetLastError(ERROR_NO_NET_OR_BAD_PATH);
					Exit;
				end;
			end
		;
	except
		SetLastError(ERROR_NOACCESS);
		Exit;
	end;
end;



function Connect(TarHost: AnsiString; Index: TSInt32): TClientRef; cdecl;
var
	TarPort: Word;
	ThisClient: TRefClient;
	Status: LongWord;

begin
	Result := nil;

	//TarPort := 8080 + (Index and $F);
	TarPort := $494F;

	ThisClient := TRefClient.Create;
	Status := ThisClient.ConnectTo(TarHost, TarPort);
	if Status <> ERROR_SUCCESS then begin
		ThisClient.Free;
		SetLastError(Status);
		Exit;
	end;

	Result := ThisClient;
	SetLastError(ERROR_SUCCESS);
end;

function ConnectA(Host: TPAnsiChar; Index: TSInt32): TClientRef; cdecl;
var
	TarHost: AnsiString;

begin
	Result := nil;
	try
		TarHost := PAnsiChar(Host);
	except
		SetLastError(ERROR_NOACCESS);
		Exit;
	end;

	Result := Connect(TarHost, Index);
end;

function ConnectW(Host: TPWideChar; Index: TSInt32): TClientRef; cdecl;
var
	TarHost: AnsiString;

begin
	Result := nil;
	try
		TarHost := AnsiString(Host);
	except
		SetLastError(ERROR_NOACCESS);
		Exit;
	end;

	Result := Connect(TarHost, Index);
end;

function ConnectU(Host: TPUCS4Char; Index: TSInt32): TClientRef; cdecl;
var
	TarHost: AnsiString;

begin
	Result := nil;
	TarHost := HostnameUToStr(Host);
	if GetLastError <> ERROR_SUCCESS then Exit;

	Result := Connect(TarHost, Index);
end;

function Disconnect(uClientRef: TClientRef): TWinErrCode; cdecl;
var
	ThisClient: TRefClient;

begin
	Result := VerifyClientRef(uClientRef);
	if Result <> ERROR_SUCCESS then Exit;

	ThisClient := Pointer(uClientRef);

	ThisClient.Free;
end;

function SetTimeout(uClientRef: TClientRef; TimeoutMS: TSInt32): TWinErrCode; cdecl;
var
	ThisClient: TRefClient;

begin
	Result := VerifyClientRef(uClientRef);
	if Result <> ERROR_SUCCESS then begin
		Exit;
	end;

	ThisClient := Pointer(uClientRef);

	if not (ThisClient.MainClientSock.bConnected and ThisClient.ContClientSock.bConnected) then begin
		Result := ERROR_NOT_CONNECTED;
		Exit;
	end;

	if TimeoutMS <= 0 then begin
		Result := ERROR_BAD_LENGTH;
		Exit;
	end;

	ThisClient.Timeout := TimeoutMS;
end;



function ChangeDeviceHostname(uClientRef: TClientRef; NewHostname: AnsiString): TWinErrCode; cdecl;
var
	ThisClient: TRefClient;
	Msg: TMessageItem;

begin
	Result := VerifyClientRef(uClientRef);
	if Result <> ERROR_SUCCESS then begin
		Exit;
	end;

	ThisClient := Pointer(uClientRef);

	try
		Msg := TMessageItem.Create;
		Msg.MID := MIDMixed;
		with THostnameDataItem(Msg.AddNewDataItem(THostnameDataItem)) do begin
			Hostname := NewHostname;
		end;
		Result := ThisClient.SendReceiveMsgAndExpectOK(Msg);

		Msg.Free;
	except
		Result := ERROR_INTERNAL_ERROR;
	end;
end;

function ChangeDeviceHostnameA(uClientRef: TClientRef; NewHostname: TPAnsiChar): TWinErrCode; cdecl;
var
	HostnameStr: AnsiString;

begin
	try
		HostnameStr := PAnsiChar(NewHostname);
	except
		Result := ERROR_NOACCESS;
		Exit;
	end;

	Result := ChangeDeviceHostname(uClientRef, HostnameStr);
end;

function ChangeDeviceHostnameW(uClientRef: TClientRef; NewHostname: TPWideChar): TWinErrCode; cdecl;
var
	HostnameStr: AnsiString;

begin
	try
		HostnameStr := AnsiString(NewHostname);
	except
		Result := ERROR_NOACCESS;
		Exit;
	end;

	Result := ChangeDeviceHostname(uClientRef, HostnameStr);
end;

function ChangeDeviceHostnameU(uClientRef: TClientRef; NewHostname: TPUCS4Char): TWinErrCode; cdecl;
var
	HostnameStr: AnsiString;

begin
	HostnameStr := HostnameUToStr(NewHostname);
	Result := GetLastError;
	if Result <> ERROR_SUCCESS then Exit;

	Result := ChangeDeviceHostname(uClientRef, HostnameStr);
end;

{
function AEW_ChangeNetworkingA(uClientRef: TClientRef; NewIP, NewSubnet, NewGateway: TPAnsiChar): TWinErrCode; cdecl;
var
	ThisClient: TRefClient;
	DataBuf, TagBuf: AnsiString;
	RawIP, RawSN, RawGW: LongWord;

begin
	Result := VerifyClientRef(uClientRef);
	if Result <> ERROR_SUCCESS then Exit;

	ThisClient := Pointer(uClientRef);

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

	try
		RawIP := inet_addr(NewIP);
		if NewSubnet = '' then
			RawSN := $00000000
		else
			RawSN := inet_addr(NewSubnet)
		;
		if NewGateway = '' then
			RawGW := $00000000
		else
			RawGW := inet_addr(NewGateway)
		;
	except
		Result := ERROR_NOACCESS;
		Exit;
	end;
	if (RawIP = INADDR_NONE) or (RawSN = INADDR_NONE) or (RawGW = INADDR_NONE) then begin
		Result := ERROR_INVALID_ADDRESS;
		Exit;
	end;

	DataBuf := StrToL8Str('ChNW' + IntAsStr(RawIP) + IntAsStr(RawSN) + IntAsStr(RawGW));

	while WaitForSingleObject(ThisClient.hGotDataSem, 0) = WAIT_OBJECT_0 do ;
	ThisClient.InBuf2 := ThisClient.InBuf2 + ThisClient.ClientSock.ReceiveStr;
	ThisClient.ClientSock.PostSendStr(DataBuf);

	//Sleep(100);

	repeat
		Result := ReceivePacket(ThisClient, DataBuf);
		if Result <> ERROR_SUCCESS then Break;

		TagBuf := Copy(DataBuf, 2, 4);
		DataBuf := Copy(DataBuf, 6, MAXINT);
		if TagBuf = 'W_OK' then begin
			Break;
		end
		else if TagBuf = '_Err' then begin
			Result := ERROR_BAD_NET_RESP;
			SetLastError(StrAsInt(DataBuf));
			Break;
		end
		else begin
			Result := ERROR_INVALID_DATA;
			ThisClient.InBuf2 := '';
			Break;
		end;
	until False;
	if (Result = ERROR_TIMEOUT) and not ThisClient.ClientSock.bConnected then Result := ERROR_NOT_CONNECTED;
end;
}



procedure BrowseCallbackV1(Status: LongWord; QueryManager: TDNSQueryManager; pDNSRecord: TPDNSRecord); stdcall;
var
	pThisRecord: TPDNSRecord;

begin
	if pDNSRecord = nil then Exit;

	pThisRecord := pDNSRecord;
	repeat
		case pThisRecord.wType of
			DNSTypeA, DNSTypeAAAA: QueryManager.Include(AnsiString(pThisRecord.pName));
			//DNSTypeA: QueryManager.Add(StrFromAddr(pThisRecord.AData.IPv4Addr) + ' = ' + AnsiString(pThisRecord.pName));
			//DNSTypeAAAA: QueryManager.Add(StrFromAddr(pThisRecord.AAAAData.IPv6Addr) + ' = ' + AnsiString(pThisRecord.pName));
			DNSTypePtr: begin
				//QueryManager.Add('Pointer: ' + AnsiString(pThisRecord.PtrData.pNameHost));
			end;
			DNSTypeSrv: begin
				{
				QueryManager.Add('Service: ' + AnsiString(pThisRecord.pName));
				QueryManager.Add('Name Target: ' + AnsiString(pThisRecord.SrvData.pNameTarget));
				QueryManager.Add('Port: ' + AnsiString(IntToHex(pThisRecord.SrvData.wPort)));
				}
			end;
			DNSTypeText: begin
				{
				QueryManager.Add(#9'Text: ' + AnsiString(pThisRecord.pName));
				for iStr := 0 to pThisRecord.TextData.dwStringCount-1 do begin
					EntryStr := AnsiString(pThisRecord.TextData.pStringArray[iStr]);
					if EntryStr <> '' then QueryManager.Add(EntryStr);
				end;
				}
			end;
		end;

		pThisRecord := pThisRecord.pNext;
	until pThisRecord = nil;

	DNSRecordListFree(pDNSRecord, 0);
end;

function ScanForDevices(MaxSize: TUInt32; var NameList: AnsiString): TWinErrCode; cdecl;
const
	QueryStr: WideString = '_aioenet._tcp.local';
	Duration = 1200; //ms

var
	SBR: TDNSServiceBrowseRequest;
	CancelRec: TDNSServiceCancel;
	QueryManager: TDNSQueryManager;

begin
	try
		if not bDNSSDLoaded then begin
			LoadDNSSD;
			if not bDNSSDLoaded then begin
				Result := ERROR_PROC_NOT_FOUND;
				Exit;
			end;
		end;

		QueryManager := TDNSQueryManager.Create;
		QueryManager.SizeLeft := MaxSize;
		try
			ZeroMemory(@SBR, SizeOf(SBR));
			SBR.Version := 1;
			SBR.QueryName := @QueryStr[1];
			SBR.pBrowseCallback := @BrowseCallbackV1;
			SBR.pQueryContext := QueryManager;
			ZeroMemory(@CancelRec, SizeOf(CancelRec));
			Result := DNSServiceBrowse(@SBR, @CancelRec);
			case Result of
				DNS_REQUEST_PENDING: Result := ERROR_SUCCESS;
				ERROR_SUCCESS: begin
					Result := ERROR_GEN_FAILURE;
					Exit;
				end;
				else Exit;
			end;

			WaitForSingleObject(QueryManager.hStopQueryEvent, Duration);

			DNSServiceBrowseCancel(@CancelRec);

			NameList := QueryManager.GetBuffer;

			{
			pThisName := NameList;
			for iName := 0 to QueryManager.GetCount-1 do begin
				ThisName := QueryManager.GetName(iName) + AnsiChar(#0);
				Move(ThisName[1], pThisName^, Length(ThisName));
				Inc(pThisName, NameSize);
				Inc(NameCount);
			end;
			}
		finally
			QueryManager.Free;
		end;

		if TUIntNative(Length(NameList)) > MaxSize then
			NameList := Copy(NameList, 1, MaxSize)
		;
	except
		Result := ERROR_INTERNAL_ERROR;
	end;
end;

function ScanForDevicesA(NameListChAvailable: TUInt32; pNameList: TPAnsiChar; out NameListCh: TUInt32): TWinErrCode; cdecl;
var
	NameList: AnsiString;
	CopyCh: TUInt32;

begin
	try
		try
			ZeroMemory(pNameList, NameListChAvailable * SizeOf(pNameList^));
			NameListCh := 0;
		except
			Result := ERROR_NOACCESS;
			Exit;
		end;

		NameList := '';

		Result := ScanForDevices(NameListChAvailable, NameList);
		if Result <> ERROR_SUCCESS then Exit;

		NameListCh := Min(NameListChAvailable, Length(NameList)-1);
		CopyCh := Min(NameListChAvailable, Length(NameList));
		Move(NameList[1], pNameList^, CopyCh * SizeOf(pNameList^));
		NameList := '';
	except
		Result := ERROR_INTERNAL_ERROR;
	end;
end;

function ScanForDevicesW(NameListChAvailable: TUInt32; pNameList: TPWideChar; out NameListCh: TUInt32): TWinErrCode; cdecl;
var
	NameListA: AnsiString;
	NameListW: WideString;
	CopyCh: TUInt32;

begin
	try
		try
			ZeroMemory(pNameList, NameListChAvailable * SizeOf(pNameList^));
			NameListCh := 0;
		except
			Result := ERROR_NOACCESS;
			Exit;
		end;

		NameListA := '';

		Result := ScanForDevices(NameListChAvailable, NameListA);
		if Result <> ERROR_SUCCESS then Exit;

		NameListW := WideString(NameListA);
		NameListA := '';

		NameListCh := Min(NameListChAvailable, Length(NameListW)-1);
		CopyCh := Min(NameListChAvailable, Length(NameListW));
		Move(NameListW[1], pNameList^, CopyCh * SizeOf(pNameList^));
		NameListW := '';
	except
		Result := ERROR_INTERNAL_ERROR;
	end;
end;

function ScanForDevicesU(NameListChAvailable: TUInt32; pNameList: TPUCS4Char; out NameListCh: TUInt32): TWinErrCode; cdecl;
var
	NameListA: AnsiString;
	NameListU: TUCS4Chars;
	CopyCh: TUInt32;

begin
	try
		try
			ZeroMemory(pNameList, NameListChAvailable * SizeOf(pNameList^));
			NameListCh := 0;
		except
			Result := ERROR_NOACCESS;
			Exit;
		end;

		NameListA := '';

		Result := ScanForDevices(NameListChAvailable, NameListA);
		if Result <> ERROR_SUCCESS then Exit;

		NameListU := HostnameStrToU(NameListA);
		NameListA := '';

		NameListCh := Min(NameListChAvailable, Length(NameListU)-1);
		CopyCh := Min(NameListChAvailable, Length(NameListU));
		Move(NameListU[0], pNameList^, CopyCh * SizeOf(pNameList^));
		SetLength(NameListU, 0);
	except
		Result := ERROR_INTERNAL_ERROR;
	end;
end;





{
function ResetDevice(uClientRef: TClientRef); cdecl;
var
	ThisClient: TRefClient;
	Msg: TMessageItem;

begin
	Result := VerifyClientRef(uClientRef);
	if Result <> ERROR_SUCCESS then Exit;

	ThisClient := Pointer(uClientRef);

	try
		Msg := TMessageItem.Create;
		Msg.MID := MIDMixed;
		with TWriteRegDataItem(Msg.AddNewDataItem(TWriteRegDataItem)) do begin
			RegOff := $00;
			RegData8 := 1;
		end;
		Result := ThisClient.SendReceiveMsgAndExpectOK(Msg);

		Msg.Free;
	except
		Result := ERROR_INTERNAL_ERROR;
	end;
end;
}

function GetDeviceFeatures(uClientRef: TClientRef; FeatureBytes: TUInt32; pFeatures: TPUInt8): TWinErrCode; cdecl;
var
	ThisClient: TRefClient;

begin
	Result := VerifyClientRef(uClientRef);
	if Result <> ERROR_SUCCESS then Exit;

	ThisClient := Pointer(uClientRef);

	try
		try
			ZeroMemory(pFeatures, FeatureBytes);
		except
			Result := ERROR_NOACCESS;
			Exit;
		end;

		Move(ThisClient.Features, pFeatures^, Min(FeatureBytes, SizeOf(ThisClient.Features)));
	except
		Result := ERROR_INTERNAL_ERROR;
	end;
end;





function Deb_SendReceiveDI(uClientRef: TClientRef; SendDID: TUInt16; SendPayloadBytes: TUInt32; pSendPayload: TPUInt8; pReceiveDID: TPUInt16; pReceivePayloadBytes: TPUInt32; pReceivePayload: TPUInt8): TWinErrCode; cdecl;
var
	ThisClient: TRefClient;
	Msg: TMessageItem;
	PayloadStr: AnsiString;
	ReceivePayloadBytes: TUInt32;

begin
	Result := VerifyClientRef(uClientRef);
	if Result <> ERROR_SUCCESS then Exit;

	ThisClient := Pointer(uClientRef);

	try
		SetString(PayloadStr, PAnsiChar(pSendPayload), SendPayloadBytes);
		pReceiveDID^ := 0;
		ReceivePayloadBytes := pReceivePayloadBytes^;
		pReceivePayloadBytes^ := 0;
		ZeroMemory(pReceivePayload, ReceivePayloadBytes);
	except
		Result := ERROR_NOACCESS;
		Exit;
	end;

	try
		Msg := TMessageItem.Create;
		try
			Msg.MID := MIDMixed;
			with TRawDataItem(Msg.AddNewDataItem(TRawDataItem)) do begin
				DID := SendDID;
				Payload := PayloadStr;
			end;
			Result := ThisClient.SendReceiveMsg(Msg, False);
			if Result <> ERROR_SUCCESS then Exit;

			if Msg.DataItemCount <> 1 then begin
				Result := ERROR_BAD_NET_RESP;
				Exit;
			end;

			with TRawDataItem(Msg.DataItem[0]) do begin
				pReceiveDID^ := DID;
				pReceivePayloadBytes^ := Length(Payload);
				Move(Payload[1], pReceivePayload^, Min(ReceivePayloadBytes, Length(Payload)));
			end;
		finally
			Msg.Free;
		end;
	except
		Result := ERROR_INTERNAL_ERROR;
	end;
end;



{
function Deb_StrToStr(uClientRef: TClientRef; SendPacket: AnsiString; var ReplyPacket: AnsiString): TWinErrCode; cdecl;
var
	ThisClient: TRefClient;

begin
	ReplyPacket := '';

	//Validate uClientRef.
	Result := VerifyClientRef(uClientRef);
	if Result <> ERROR_SUCCESS then Exit;

	ThisClient := Pointer(uClientRef);

	Result := ThisClient.SendReceivePacket(SendPacket, ReplyPacket);
end;

function Deb_StrToStrA(uClientRef: TClientRef; pSendPacketChars: PLongInt; pSendPacket: TPAnsiChar; pReplyPacketChars: PLongInt; pReplyPacket: TPAnsiChar): TWinErrCode; cdecl;
var
	ReplyPacketChars: Longint;
	SendPacket, ReplyPacket: AnsiString;
	L: Integer;

begin
	//Validate send packet.
	try
		SetString(SendPacket, pSendPacket, pSendPacketChars^);
	except
		Result := ERROR_NOACCESS;
		try pReplyPacketChars^ := 0; except end;
		Exit;
	end;

	//Validate reply packet.
	try
		ReplyPacketChars := pReplyPacketChars^;
		pReplyPacketChars^ := 0;
	except
		Result := ERROR_NOACCESS;
		Exit;
	end;
	if ReplyPacketChars <= 0 then begin
		Result := ERROR_BAD_LENGTH;
		Exit;
	end;
	try
		FillChar(pReplyPacket^, ReplyPacketChars, 0);
	except
		Result := ERROR_NOACCESS;
		Exit;
	end;

	//Transact.
	Result := Deb_StrToStr(uClientRef, SendPacket, ReplyPacket);
	if Result <> ERROR_SUCCESS then Exit;

	//Retrieve reply.
	if Length(ReplyPacket) <> 0 then begin
		L := Min(ReplyPacketChars, Length(ReplyPacket));
		try
			Move(ReplyPacket[1], pReplyPacket^, L * SizeOf(ReplyPacket[1]));
		except
			Result := ERROR_NOACCESS;
			L := 0;
		end;
		pReplyPacketChars^ := L;
	end;
end;

function Deb_StrToStrW(uClientRef: TClientRef; pSendPacketChars: PLongInt; pSendPacket: TPWideChar; pReplyPacketChars: PLongInt; pReplyPacket: TPWideChar): TWinErrCode; cdecl;
var
	ReplyPacketChars: Longint;
	WSendPacket, WReplyPacket: WideString;
	SendPacket, ReplyPacket: AnsiString;
	L: Integer;

begin
	//Validate send packet.
	try
		SetString(WSendPacket, pSendPacket, pSendPacketChars^);
	except
		Result := ERROR_NOACCESS;
		try pReplyPacketChars^ := 0; except end;
		Exit;
	end;

	//Validate reply packet.
	try
		ReplyPacketChars := pReplyPacketChars^;
		pReplyPacketChars^ := 0;
	except
		Result := ERROR_NOACCESS;
		Exit;
	end;
	if ReplyPacketChars <= 0 then begin
		Result := ERROR_BAD_LENGTH;
		Exit;
	end;
	try
		FillChar(pReplyPacket^, ReplyPacketChars, 0);
	except
		Result := ERROR_NOACCESS;
		Exit;
	end;

	//Convert from UTF-16.
	SendPacket := AnsiString(WSendPacket);

	//Transact.
	Result := Deb_StrToStr(uClientRef, SendPacket, ReplyPacket);
	if Result <> ERROR_SUCCESS then Exit;

	//Convert to UTF-16.
	WReplyPacket := WideString(ReplyPacket);

	//Retrieve reply.
	if Length(WReplyPacket) <> 0 then begin
		L := Min(ReplyPacketChars, Length(WReplyPacket));
		try
			Move(WReplyPacket[1], pReplyPacket^, L * SizeOf(WReplyPacket[1]));
		except
			Result := ERROR_NOACCESS;
			L := 0;
		end;
		pReplyPacketChars^ := L;
	end;
end;

function Deb_StrToStrU(uClientRef: TClientRef; pSendPacketChars: PLongInt; pSendPacket: TPUCS4Char; pReplyPacketChars: PLongInt; pReplyPacket: TPUCS4Char): TWinErrCode; cdecl;
var
	ReplyPacketChars: Longint;
	USendPacket, UReplyPacket: UCS4String;
	SendPacket, ReplyPacket: AnsiString;
	I, L: Integer;

begin
	//Validate send packet.
	try
		SetLength(USendPacket, pSendPacketChars^);
		Move(pSendPacket^, USendPacket[0], pSendPacketChars^ * SizeOf(USendPacket[0]));
	except
		Result := ERROR_NOACCESS;
		try pReplyPacketChars^ := 0; except end;
		Exit;
	end;

	//Validate reply packet.
	try
		ReplyPacketChars := pReplyPacketChars^;
		pReplyPacketChars^ := 0;
	except
		Result := ERROR_NOACCESS;
		Exit;
	end;
	if ReplyPacketChars <= 0 then begin
		Result := ERROR_BAD_LENGTH;
		Exit;
	end;
	try
		FillChar(pReplyPacket^, ReplyPacketChars, 0);
	except
		Result := ERROR_NOACCESS;
		Exit;
	end;

	//Convert from UCS-4.
	SetLength(SendPacket, Length(USendPacket));
	for I := 0 to High(USendPacket) do
		case USendPacket[I] of
			Byte('a')..Byte('z'): SendPacket[1 + I] := TAnsiChar(USendPacket[I] - (Byte('a') - Byte('A')));
			Byte('A')..Byte('Z'),
			Byte('0')..Byte('9')
			: SendPacket[1 + I] := TAnsiChar(USendPacket[I]);
			else begin
				Result := ERROR_INVALID_MESSAGE;
				Exit;
			end;
		end
	;

	//Transact.
	Result := Deb_StrToStr(uClientRef, SendPacket, ReplyPacket);
	if Result <> ERROR_SUCCESS then Exit;

	//Convert to UCS-4.
	SetLength(UReplyPacket, Length(ReplyPacket));
	for I := 0 to High(UReplyPacket) do
		case ReplyPacket[1 + I] of
			'A'..'Z',
			'0'..'9'
			: UReplyPacket[I] := Byte(ReplyPacket[1 + I]);
			else begin
				SetLastError(ERROR_INVALID_DATA);
				Exit;
			end;
		end
	;

	//Retrieve reply.
	if Length(UReplyPacket) <> 0 then begin
		L := Min(ReplyPacketChars, Length(UReplyPacket));
		try
			Move(UReplyPacket[0], pReplyPacket^, L * SizeOf(UReplyPacket[0]));
		except
			Result := ERROR_NOACCESS;
			L := 0;
		end;
		pReplyPacketChars^ := L;
	end;
end;
}

function Deb_LogEnable: LongBool; cdecl;
begin
	Result := False;
end;
{
const
	LogDirPath = 'C:\ENetLog\';

var
	Naui: TDateTime;
	LogFilePath: AnsiString;
	Year, Month, Day,
	Hour, Min, Sec, MSec: Word;

begin
	Result := bLogging;
	if Result then Exit;

	if not ForceDirectories(LogDirPath) then Exit;

	Naui := Now;
	DecodeDate(Naui, Year, Month, Day);
	DecodeTime(Naui, Hour, Min, Sec, MSec);
	LogFilePath := LogDirPath + Format('%.4d-%.2d-%.2d %.2d-%.2d-%.2d.txt', [ Year, Month, Day, Hour, Min, Sec ]);

	try
		LogFil := TFileStream.Create(LogFilePath, fmCreate);
		FreeAndNil(LogFil);
		LogFil := TFileStream.Create(LogFilePath, fmOpenReadWrite or fmShareDenyNone);
	except
		try
			if LogFil <> nil then LogFil.Free;
		except
		end;
		LogFil := nil;
		Result := False;
		Exit;
	end;
	bLogging := True;
	Result := True;
end;
}



{ TMDNSQueryManager }

constructor TDNSQueryManager.Create;
begin
	hStopQueryEvent := CreateEvent(nil, True, False, nil);
	SetLength(Name, 0);
end;

destructor TDNSQueryManager.Destroy;
begin
	CloseHandle(hStopQueryEvent);
	hStopQueryEvent := INVALID_HANDLE_VALUE;

	inherited;
end;

function TDNSQueryManager.GetBuffer: AnsiString;
const
  Return: AnsiString = #13#10;

var
  I, L, Size, hName: Integer;
  P: PAnsiChar;
  S: AnsiString;

begin
  hName := High(Name);
  Size := Max(0, hName) * Length(Return) + 1;
  for I := 0 to hName do Inc(Size, Length(Name[I]));
  SetString(Result, nil, Size);
  P := Pointer(Result);
  for I := 0 to hName do begin
    S := Name[I];
    L := Length(S);
    if L <> 0 then begin
      System.Move(Pointer(S)^, P^, L * SizeOf(P^));
      Inc(P, L);
    end;
    if I < hName then begin
      L := Length(Return);
      System.Move(Pointer(Return)^, P^, L * SizeOf(P^));
      Inc(P, L);
    end;
  end;
  P^ := #0;
end;

procedure TDNSQueryManager.Include(NewName: AnsiString);
var
	I: TSIntNative;
	L: TUIntNative;
begin
	//if Length(NewName) > $FF then NewName := Copy(NewName, 1, $FE) + '…';

	for I := 0 to High(Name) do
		if Name[I] = NewName then
			Exit
	;

	L := Length(NewName)+2;
	if SizeLeft < L then begin
		SetEvent(hStopQueryEvent);
		Exit;
	end;
	Dec(SizeLeft, L);

	I := Length(Name);
	SetLength(Name, I+1);
	Name[I] := NewName;
end;

end.
