unit XStrUtils;

interface

uses
	SysUtils, Variants, Math;

type
	EXStrConvert = Exception;

const
	XStrNULL = '{{null}}';
	XStrNULLCaption = '< пусто >';

	function XStrTypeToVarType(const aDataType: String): Integer;

	function XStrToVariant(const aValue: String; aDataType: Integer): Variant; overload;
	function XStrToVariant(const aValue, aDataType: String): Variant; overload;
	function XStrToVariantDef(const aValue: String; aDataType: Integer; const aDefValue: Variant): Variant; overload;
	function XStrToVariantDef(const aValue, aDataType: String; const aDefValue: Variant): Variant; overload;

	// если TimeZone отсутствует, то возвращается NULL
	function XStrToVariantTimeZone(const aValue: String): Variant;
	function VariantToXStr(const aValue: Variant): String;

	function StrToXStr(const aValue: Variant): String;
	function XStrToStr(const aValue: String): Variant; overload;
	function XStrToStr(const aValue: String; aNullValue: String): String; overload;

	function BoolToXStr(const aValue: Variant; aTrueFalseMode: Boolean = False): String;
	function XStrToBool(const aValue: String): Variant; overload;
	function XStrToBool(const aValue: String; aNullValue: Boolean): Boolean; overload;

	function DateToXStr(const aValue: Variant): String;
	function XStrToDate(const aValue: String): Variant; overload;
	function XStrToDate(const aValue: String; aNullValue: TDateTime): TDateTime; overload;

	// краткое замечание насчет часовых поясов
	// если в процедурах преобразования времени в XStr задается корректный часовой пояс abs(aTimeZoneHour)<25,
	// то в результат добавляется информация о TimeZone, иначе никакой информации о
	// TimeZone не заноситься

	// если процедуры XStrToTime, XStrToDateTime
	// возвратили корректную TimeZone значит она была задана
	// иначе они возвратят 1

	// проводят преобразование TimeZone в TimeZoneHour and TimeZoneMinute и наоборот
	function  EncodeTimeZone(aTimeZoneHour: Smallint = 25; aTimeZoneMinute: Word = 0): TDateTime;
	procedure DecodeTimeZone(const aDateTime: TDateTime; out aTimeZoneHour: Smallint; out aTimeZoneMinute: Word);

	function TimeToXStr(const aValue: Variant; aTimeZoneHour: Smallint = 25; aTimeZoneMinute: Word = 0): String;
	function XStrToTime(const aValue: String; var aTimeZone: TDateTime): Variant; overload;
	function XStrToTime(const aValue: String;
		var aTimeZone: TDateTime; aNullValue: TDateTime): TDateTime; overload;

	function DateTimeToXStr(const aValue: Variant; aTimeZoneHour: Smallint = 25; aTimeZoneMinute: Word = 0): String;
	function XStrToDateTime(const aValue: String; var aTimeZone: TDateTime): Variant; overload;
	function XStrToDateTime(const aValue: String; var aTimeZone: TDateTime;
		aNullValue: TDateTime): TDateTime; overload;

	function XStrToTimeZone(const aValue: String; var aTimeZone: TDateTime): Boolean;

	function IntToXStr(const aValue: Variant): String;
	function XStrToInt(const aValue: String): Variant; overload;
	function XStrToInt(const aValue: String; aNullValue: Integer): Integer; overload;

	function Int64ToXStr(const aValue: Variant): String;
	function XStrToInt64(const aValue: String): Variant; overload;
	function XStrToInt64(const aValue: String; aNullValue: Int64): Int64; overload;

	function ExtendedToXStr(const aValue: Variant): String;
	function XStrToExtended(const aValue: String): Variant; overload;
	function XStrToExtended(const aValue: String; aNullValue: Extended): Extended; overload;

	function CurrencyToXStr(const aValue: Variant): String;
	function XStrToCurrency(const aValue: String): Variant; overload;
	function XStrToCurrency(const aValue: String; aNullValue: Currency): Currency; overload

	function BinToXStr(const aValue: Variant): String;
	function XStrToBin(const aValue: String): Variant;

	function  BinToBase64(const aBin; aSize: Integer): String;
	function  Base64Size(const aBase64: String): Integer;
	procedure Base64ToBin(const aBase64: String; var aData; aSize: Integer); overload;
	function  Base64ToBin(const aBase64: String): String; overload;

implementation

uses
	DateUtils;

type
	TStrArray = array of String;
	TIntArray = array of Integer;

function VarAsType_N(const aValue: Variant; aDataType: Integer): Variant;
begin
	if not VarIsNull(aValue) then
		Result := VarAsType(aValue, aDataType)
	else
		Result := aValue;
end;

function Split(const aValue: String; aDelimiter: Char): TStrArray;
var
	aLength, i: Integer;
	aData: String;
begin
	Result := nil;
	aLength := Length(aValue);
	i := 1;
	while i <= aLength do begin
		aData := '';
		while (i <= aLength) and (aValue[i] <> aDelimiter) do begin
			aData := aData + aValue[i];
			Inc(i);
		end;
		Inc(i);

		SetLength(Result, Length(Result) + 1);
		Result[High(Result)] := aData;
	end;
end;

function IntToStrLZ(aValue: Integer; aLength: Integer; aSignNecessarily: Boolean = False): String;
begin
	Result := IntToStr(Abs(aValue));
	if aLength > 0 then begin
		if (aValue < 0) or aSignNecessarily then
			Dec(aLength);

		Result := StringOfChar('0', aLength - Length(Result)) + Result;

		if aValue < 0 then
			Result := '-' + Result
		else if aSignNecessarily then
			Result := '+' + Result;
	end
	else if aValue < 0 then
		Result := '-' + Result;
end;

procedure CheckError(anIsOk: Boolean; const aMsg: String);
begin
	if not anIsOk then
		raise EXStrConvert.Create(aMsg);
end;

var
	Base64Map: array [0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

type
	PChars = ^TChars;
	TChars = packed record a, b, c, d: AnsiChar end;
	POctet = ^TOctet;
	TOctet = packed record a, b, c: Byte; end;

procedure OctetToChars(po: POctet; aCount: Integer; pc: PChars);
var
	o: Integer;
begin
	if aCount = 1 then begin
		o := po.a shl 16;
		LongWord(pc^) := $3D3D3D3D;
		pc.a := Base64Map[(o shr 18) and $3F];
		pc.b := Base64Map[(o shr 12) and $3F];
	end
	else if aCount = 2 then begin
		o := po.a shl 16 or po.b shl 8;
		LongWord(pc^) := $3D3D3D3D;
		pc.a := Base64Map[(o shr 18) and $3F];
		pc.b := Base64Map[(o shr 12) and $3F];
		pc.c := Base64Map[(o shr 6) and $3F];
	end
	else if aCount > 2 then begin
		o := po.a shl 16 or po.b shl 8 or po.c;
		LongWord(pc^) := $3D3D3D3D;
		pc.a := Base64Map[(o shr 18) and $3F];
		pc.b := Base64Map[(o shr 12) and $3F];
		pc.c := Base64Map[(o shr 6) and $3F];
		pc.d := Base64Map[o and $3F];
	end;
end;

function BinToBase64(const aBin; aSize: Integer): String;
var
	o: POctet;
	c: PChars;
	aCount: Integer;
begin
	o := @aBin;
	aCount := aSize;

	SetLength(Result, ((aCount + 2) div 3)*4);
	c := PChars(Result);
	while aCount > 0 do begin
		OctetToChars(o, aCount, c);
		Inc(o);
		Inc(c);
		Dec(aCount, 3);
	end;
end;

function CharTo6Bit(c: Char): Byte;
begin
	if (c >= 'A') and (c <= 'Z') then
		Result := Ord(c) - Ord('A')
	else if (c >= 'a') and (c <= 'z') then
		Result := Ord(c) - Ord('a') + 26
	else if (c >= '0') and (c <= '9') then
		Result := Ord(c) - Ord('0') + 52
	else if c = '+' then
		Result := 62
	else if c = '/' then
		Result := 63
	else
		raise EXStrConvert.Create('Can''t convert base64 char to bin');
end;

procedure CharsToOctet(c: PChars; o: POctet);
var
	i: Integer;
begin
	if c.c = '=' then begin // 1 byte
		i := CharTo6Bit(c.a) shl 18 or CharTo6Bit(c.b) shl 12;
		o.a := (i shr 16) and $FF;
	end
	else if c.d = '=' then begin // 2 bytes
		i := CharTo6Bit(c.a) shl 18 or CharTo6Bit(c.b) shl 12 or CharTo6Bit(c.c) shl 6;
		o.a := (i shr 16) and $FF;
		o.b := (i shr 8) and $FF;
	end
	else begin // 3 bytes
		i := CharTo6Bit(c.a) shl 18 or CharTo6Bit(c.b) shl 12 or CharTo6Bit(c.c) shl 6 or CharTo6Bit(c.d);
		o.a := (i shr 16) and $FF;
		o.b := (i shr 8) and $FF;
		o.c := i and $FF;
	end;
end;

function Base64Size(const aBase64: String): integer;
var
	s: String;
	i, j: Integer;
begin
	s := aBase64;
	i := 1;
	while i <= Length(s) do begin
		while (i <= Length(s)) and (s[i] > ' ') do
			Inc(i);
		if i <= Length(s) then begin
			j := i;
			while (j <= Length(s)) and (s[j] <= ' ') do
				Inc(j);
			Delete(s, i, j - i);
		end;
	end;

	if Length(s) = 0 then
		Result := 0
	else begin
		if Length(s) < 4 then
			raise EXStrConvert.Create('Invalid base64 string: Length < 4');

		Result := ((Length(s) + 3) div 4)*3;
		if Result > 0 then begin
			if s[Length(s) - 1] = '=' then
				Dec(Result, 2)
			else if s[Length(s)] = '=' then
				Dec(Result);
		end;
	end;
end;

procedure Base64ToBin(const aBase64: String; var aData; aSize: Integer);
var
	o: POctet;
	c: PChars;
	aCount: Integer;
	s: String;
	i, j: Integer;
begin
	s := aBase64;
	i := 1;
	while i <= Length(s) do begin
		while (i <= Length(s)) and (s[i] > ' ') do
			Inc(i);
		if i <= Length(s) then begin
			j := i;
			while (j <= Length(s)) and (s[j] <= ' ') do
				Inc(j);
			Delete(s, i, j - i);
		end;
	end;

	if Length(s) > 0 then begin

		if Length(s) < 4 then
			raise EXStrConvert.Create('Can''t convert base64 string to binary');

		aCount := ((Length(s) + 3) div 4)*3;
		if aCount > 0 then begin
			if s[Length(s) - 1] = '=' then
				Dec(aCount, 2)
			else if s[Length(s)] = '=' then
				Dec(aCount);
			if aCount <> aSize then
				raise EXStrConvert.Create('Can''t convert base64 string to binary');

			c := @s[1];
			o := @aData;
			while aCount > 0 do begin
				CharsToOctet(c, o);
				Inc(o);
				Inc(c);
				Dec(aCount, 3);
			end;
		end;
	end;
end;

function Base64ToBin(const aBase64: String): String;
var
	o: POctet;
	c: PChars;
	aCount: Integer;
	s: String;
	i, j: Integer;
begin
	s := aBase64;
	i := 1;
	while i <= Length(s) do begin
		while (i <= Length(s)) and (s[i] > ' ') do
			Inc(i);
		if i <= Length(s) then begin
			j := i;
			while (j <= Length(s)) and (s[j] <= ' ') do
				Inc(j);
			Delete(s, i, j - i);
		end;
	end;

	if Length(s) > 0 then begin

		if Length(s) < 4 then
			raise EXStrConvert.Create('Can''t convert base64 string to binary');

		aCount := ((Length(s) + 3) div 4)*3;
		if aCount > 0 then begin
			if s[Length(s) - 1] = '=' then
				Dec(aCount, 2)
			else if s[Length(s)] = '=' then
				Dec(aCount);
			SetLength(Result, aCount);
			FillChar(Result[1], aCount, '*');
			c := @s[1];
			o := @Result[1];
			while aCount > 0 do begin
				CharsToOctet(c, o);
				Inc(o);
				Inc(c);
				Dec(aCount, 3);
			end;
		end;
	end;
end;

function XStrTypeToVarType(const aDataType: String): Integer;
const
	aTypes: array[0..11] of record X: String; V: Integer; end = (
		(X: 'boolean';  V: varBoolean),
		(X: 'uint8';    V: varByte),
		(X: 'int16';    V: varSmallint),
		(X: 'int32';    V: varInteger),
		(X: 'single';   V: varSingle),
		(X: 'double';   V: varDouble),
		(X: 'currency'; V: varCurrency),
		(X: 'datetime'; V: varDate),
		(X: 'char';     V: varOleStr),
		(X: 'string';   V: varOleStr),
		(X: 'text';     V: varOleStr),
		(X: 'binary';   V: varArray or varByte));
var
	i: Integer;
begin
	for i := Low(aTypes) to High(aTypes) do
		if aTypes[i].X = aDataType then begin
			Result := aTypes[i].V;
			exit;
		end;
	raise Exception.Create('Неизвестный XStr-тип "' + aDataType + '"');
end;

function XStrToVariant(const aValue: String; aDataType: Integer): Variant;
var
	aTimeZone: TDateTime;
begin
	case aDataType of
		varInteger,
		varSmallint,
		varShortInt,
		varByte,
		varWord,
		varLongWord,
		varError	 : Result := XStrToInt(aValue);
		varInt64	 : Result := XStrToInt64(aValue);

		varSingle	 : Result := VarAsType_N(XStrToExtended(aValue), aDataType);
		varDouble	 : Result := VarAsType_N(XStrToExtended(aValue), aDataType);
		varCurrency: Result := XStrToCurrency(aValue);

		varDate   : Result := XStrToDateTime(aValue, aTimeZone);
		varBoolean: Result := XStrToBool(aValue);

		varString,
		varStrArg,
		varOleStr: Result := XStrToStr(aValue);
		varArray or varByte: Result := XStrToBin(aValue);
		else
			raise EXStrConvert.CreateFmt('Невозможно сконвертировать строку "%s" в variant c типом "%d"', [aValue, aDataType]);
	end;
end;

function XStrToVariant(const aValue, aDataType: String): Variant;
begin
	Result := XStrToVariant(aValue, XStrTypeToVarType(aDataType));
end;

function XStrToVariantDef(const aValue: String; aDataType: Integer; const aDefValue: Variant): Variant;
begin
	try
		Result := XStrToVariant(aValue, aDataType);
	except
		Result := aDefValue;
	end;
end;

function XStrToVariantDef(const aValue, aDataType: String; const aDefValue: Variant): Variant;
begin
	try
		Result := XStrToVariant(aValue, aDataType);
	except
		Result := aDefValue;
	end;
end;

function XStrToVariantTimeZone(const aValue: String): Variant;
var
	aTimeZone: TDateTime;
begin
	if XStrToTimeZone(aValue, aTimeZone) then
		Result := aTimeZone
	else
		Result := Null;
end;

function VariantToXStr(const aValue: Variant): String;
begin
	case VarType(aValue) of
		varEmpty,
		varNull: Result := XStrNULL;

		varSmallint,
		varInteger,
		varShortInt,
		varByte,
		varWord,
		varLongWord,
		varError   : Result := IntToXStr(aValue);
		varInt64   : Result := Int64ToXStr(aValue);

		varSingle,
		varDouble	 : Result := ExtendedToXStr(aValue);
		varCurrency: Result := CurrencyToXStr(aValue);

		varDate   : Result := DateTimeToXStr(aValue);
		varBoolean: Result := BoolToXStr(aValue);

		varString,
		varStrArg,
		varOleStr: Result := StrToXStr(aValue);
		varArray or varByte: Result := BinToXStr(aValue);
		else
			raise EXStrConvert.CreateFmt('Невозможно сконвертировать variant с типом "%d" в XStr-строку', [VarType(aValue)]);
	end;
end;

function StrToXStr(const aValue: Variant): String;
begin
	if VarIsNull(aValue) or VarIsEmpty(aValue) then
		Result := XStrNULL
	else
		Result := aValue;
end;

function XStrToStr(const aValue: String): Variant;
begin
	if aValue = XStrNULL then
		Result := Null
	else
		Result := aValue;
end;

function XStrToStr(const aValue: String; aNullValue: String): String;
var
	aStrValue: Variant;
begin
	aStrValue := XStrToStr(aValue);
	if VarIsNull(aStrValue) then
		Result := aNullValue
	else
		Result := aStrValue;
end;

function BoolToXStr(const aValue: Variant; aTrueFalseMode: Boolean): String;
begin
	if VarIsNull(aValue) or VarIsEmpty(aValue) then
		Result := XStrNULL
	else if aTrueFalseMode then begin
		if aValue then
			Result := 'true'
		else
			Result := 'false';
	end
	else begin
		if aValue then
			Result := '1'
		else
			Result := '0';
	end;
end;

function XStrToBool(const aValue: String): Variant;
begin
	if aValue = XStrNULL then
		Result := Null
	else if (aValue = '1') or SameText(aValue, 'true') then
		Result := True
	else if (aValue = '0') or SameText(aValue, 'false') then
		Result := False
	else
		raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в логическое значение.', [aValue]);
end;

function XStrToBool(const aValue: String;
	aNullValue: Boolean): Boolean; 
var
	aBoolValue: Variant;
begin
	aBoolValue := XStrToBool(aValue);
	if VarIsNull(aBoolValue) then
		Result := aNullValue
	else
		Result := aBoolValue;
end;

function DateToXStr(const aValue: Variant): String;
var
	aYear, aMonth, aDay: Word;
begin
	if VarIsNull(aValue) or VarIsEmpty(aValue) then
		Result := XStrNULL
	else begin
		DecodeDate(aValue, aYear, aMonth, aDay);
		Result :=
			IntToStrLZ(aYear, 4) + '-' +
			IntToStrLZ(aMonth, 2) + '-' +
			IntToStrLZ(aDay, 2);
	end;
end;

function XStrToDate(const aValue: String): Variant;
var
	aDate: TStrArray;
begin
	aDate := nil;
	if aValue = XStrNULL then
		Result := Null
	else begin
		try
			if Pos('-', aValue) = 0 then begin
				// Old format
				aDate := Split(aValue, '.');
				if Length(aDate) <> 3 then
					raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в значение даты', [aValue]);
				Result := EncodeDate(StrToInt(aDate[2]), StrToInt(aDate[1]), StrToInt(aDate[0]));
			end
			else begin
				// New format
				aDate := Split(aValue, '-');
				if Length(aDate) <> 3 then
					raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в значение даты', [aValue]);
				Result := EncodeDate(StrToInt(aDate[0]), StrToInt(aDate[1]), StrToInt(aDate[2]));
			end;
		except
			on E:EXStrConvert do
				raise;
			on E: Exception do
				raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в значение даты.'^M^J'Ошибка: %s', [aValue, E.Message]);
		end;
	end;
end;

function XStrToDate(const aValue: String; aNullValue: TDateTime): TDateTime;
var
	aDateTimeValue: Variant;
begin
	aDateTimeValue := XStrToDate(aValue);
	if VarIsNull(aDateTimeValue) then
		Result := aNullValue
	else
		Result := aDateTimeValue;
end;

function EncodeTimeZone(aTimeZoneHour: Smallint = 25; aTimeZoneMinute: Word = 0): TDateTime;
begin
	if (aTimeZoneHour > -25) and (aTimeZoneHour < 25) then
		Result := Sign(aTimeZoneHour)*EncodeTime(Abs(aTimeZoneHour), aTimeZoneMinute, 0, 0)
	else
		Result := 1;
end;

procedure DecodeTimeZone(const aDateTime: TDateTime; out aTimeZoneHour: Smallint; out aTimeZoneMinute: Word);
var
	aHour, aMinute, aSecond, aMillisecond: Word;
begin
	if aDateTime < 1 then begin
		DecodeTime(Abs(aDateTime), aHour, aMinute, aSecond, aMillisecond);
		aTimeZoneHour := Sign(aDateTime)*aHour;
		aTimeZoneMinute := aMinute;
	end
	else begin
		aTimeZoneHour := 25;
		aTimeZoneMinute := 0;
	end;
end;

function TimeToXStr(const aValue: Variant; aTimeZoneHour: Smallint = 25; aTimeZoneMinute: Word = 0): String;
var
	aHour, aMin, aSec, aMSec: Word;
begin
	if VarIsNull(aValue) or VarIsEmpty(aValue) then
		Result := XStrNULL
	else begin
		DecodeTime(aValue, aHour, aMin, aSec, aMSec);
		Result := IntToStrLZ(aHour, 2) + ':' + IntToStrLZ(aMin, 2) + ':' +
			IntToStrLZ(aSec, 2);

		if (aTimeZoneHour > -25) and (aTimeZoneHour < 25) then begin
			Assert(aTimeZoneMinute < 60);
			if aTimeZoneMinute < 60 then begin
				if (aTimeZoneHour = 0) and (aTimeZoneMinute = 0) then
					Result := Result + 'Z'
				else
					Result := Result + IntToStrLZ(aTimeZoneHour, 3, True) + ':' +
						IntToStrLZ(aTimeZoneMinute, 2);
			end;
		end;
	end;
end;

function XStrToTime(const aValue: String; var aTimeZone: TDateTime): Variant;

	function ParseTime(const aTimeValue: String; aMinTimePartCount, aMaxTimePartCount: Integer): TDateTime;
	var
		aTime: TStrArray;
		aPos: Integer;
	begin
		aTime := Split(aTimeValue, ':');
		if (Length(aTime) > aMaxTimePartCount) or (Length(aTime) < aMinTimePartCount) then
			raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в значение времени', [aValue]);
		case Length(aTime) of
			2: Result := EncodeTime(StrToInt(aTime[0]), StrToInt(aTime[1]), 0, 0);
			3: begin
				aPos := Pos('.', aTime[2]);
				if aPos = 0 then
					Result := EncodeTime(StrToInt(aTime[0]), StrToInt(aTime[1]), StrToInt(aTime[2]), 0)
				else //!!! Доли секунды пока не учитываем
					Result := EncodeTime(StrToInt(aTime[0]), StrToInt(aTime[1]), StrToInt(Copy(aTime[2], 1, aPos - 1)), 0);
			end
			else
				raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в значение времени', [aValue]);
		end;
	end;

var
	aTimeValue: String;
	aTimeZoneValue: String;
	i: Integer;
begin
	aTimeZone := 1;
	if aValue = XStrNULL then
		Result := Null
	else begin
		try
			i := Pos('+', aValue);
			if i > 0 then begin
				aTimeValue := Copy(aValue, 1, i - 1);
				aTimeZoneValue := Copy(aValue, i + 1, Length(aValue) - i);
				aTimeZone := ParseTime(aTimeZoneValue, 2, 2);
				Result := ParseTime(aTimeValue, 3, 3);
			end
			else begin
				i := Pos('-', aValue);
				if i > 0 then begin
					aTimeValue := Copy(aValue, 1, i - 1);
					aTimeZoneValue := Copy(aValue, i + 1, Length(aValue) - i);
					aTimeZone := -ParseTime(aTimeZoneValue, 2, 2);
					Result := ParseTime(aTimeValue, 3, 3);
				end
				else begin
					aTimeValue := aValue;
					if aTimeValue[Length(aTimeValue)] = 'Z' then begin
						aTimeValue := Copy(aValue, 1, Length(aTimeValue) - 1);
						aTimeZone := 0;
					end
					else
						aTimeZone := 1;
					Result := ParseTime(aTimeValue, 3, 3);
				end;
			end;
		except
			on E: EXStrConvert do
				raise;
			on E: Exception do
				raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в значение времени.'^M^J'Ошибка: %s', [aValue, E.Message]);
		end;
	end;
end;

function XStrToTime(const aValue: String;
	var aTimeZone: TDateTime; aNullValue: TDateTime): TDateTime;
var
	aTimeValue: Variant;
begin
	aTimeValue := XStrToTime(aValue, aTimeZone);
	if VarIsNull(aTimeValue) then
		Result := aNullValue
	else
		Result := aTimeValue;
end;

function DateTimeToXStr(const aValue: Variant; aTimeZoneHour: Smallint = 25; aTimeZoneMinute: Word = 0): String;
begin
	if VarIsNull(aValue) or VarIsEmpty(aValue) then
		Result := XStrNULL
	else
		Result := DateToXStr(aValue) + 'T' + TimeToXStr(aValue, aTimeZoneHour, aTimeZoneMinute);
end;

function XStrToDateTime(const aValue: String; var aTimeZone: TDateTime): Variant;
var
	aDateTime: TStrArray;
begin
	aDateTime := nil;
	if aValue = XStrNULL then
		Result := Null
	else begin
		try
			aTimeZone := 1;
			if Pos('T', aValue) = 0 then
				aDateTime := Split(aValue, ' ')
			else
				aDateTime := Split(aValue, 'T');
			if Length(aDateTime) = 2 then
				Result := XStrToDate(aDateTime[0]) + XStrToTime(aDateTime[1], aTimeZone)
			else if (Length(aDateTime) = 1) and (Pos(':', aDateTime[0]) <> 0) then
				Result := XStrToTime(aDateTime[0], aTimeZone)
			else if Length(aDateTime) = 1 then
				Result := XStrToDate(aDateTime[0])
			else
				raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в значение даты-времени.', [aValue]);
		except
			on EXStrConvert do
				raise;
			on E: Exception do
				raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в значение даты-времени.'^M^J'Ошибка: %s', [aValue, E.Message]);
		end;
	end;
end;

function XStrToDateTime(const aValue: String; var aTimeZone: TDateTime;
	aNullValue: TDateTime): TDateTime;
var
	aDateTimeValue: Variant;
begin
	aDateTimeValue := XStrToDateTime(aValue, aTimeZone);
	if VarIsNull(aDateTimeValue) then
		Result := aNullValue
	else
		Result := aDateTimeValue;
end;

function XStrToTimeZone(const aValue: String; var aTimeZone: TDateTime): Boolean;
var
	aDateTime: Variant;
begin
	try
		aDateTime := XStrToDateTime(aValue, aTimeZone);
		Result := not VarIsNull(aDateTime) and (aTimeZone < 1);
	except
		on E: EXStrConvert do
			raise;
		on E: Exception do
			raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в значение даты-времени.'^M^J'Ошибка: %s', [aValue, E.Message]);
	end;
end;

function IntToXStr(const aValue: Variant): String;
begin
	if VarIsNull(aValue) or VarIsEmpty(aValue) then
		Result := XStrNULL
	else
		Result := IntToStr(aValue);
end;

function XStrToInt(const aValue: String): Variant;
begin
	try
		if aValue = XStrNULL then
			Result := Null
		else
			Result := StrToInt(aValue);
	except
		on E: Exception do
			raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в целое значение.'^M^J'Ошибка: %s', [aValue, E.Message]);
	end;
end;

function XStrToInt(const aValue: String; aNullValue: Integer): Integer; overload;
var
	aIntValue: Variant;
begin
	aIntValue := XStrToInt(aValue);
	if VarIsNull(aIntValue) then
		Result := aNullValue
	else
		Result := aIntValue;
end;

function Int64ToXStr(const aValue: Variant): String;
begin
	if VarIsNull(aValue) or VarIsEmpty(aValue) then
		Result := XStrNULL
	else
		Result := IntToStr(aValue);
end;

function XStrToInt64(const aValue: String): Variant;
begin
	try
		if aValue = XStrNULL then
			Result := Null
		else
			Result := StrToInt64(aValue);
	except
		on E: Exception do
			raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в 64-е целое значение.'^M^J'Ошибка: %s', [aValue, E.Message]);
	end;
end;

function XStrToInt64(const aValue: String; aNullValue: Int64): Int64;
var
	aIntValue: Variant;
begin
	aIntValue := XStrToInt64(aValue);
	if VarIsNull(aIntValue) then
		Result := aNullValue
	else
		Result := aIntValue;
end;

function ExtendedToXStr(const aValue: Variant): String;
var
	aSaveDecimal: Char;
begin
	if VarIsNull(aValue) or VarIsEmpty(aValue) then
		Result := XStrNULL
	else begin
		aSaveDecimal := DecimalSeparator;
		try
			DecimalSeparator := '.';
			Result := FloatToStr(aValue);
			Result := StringReplace(Result, ' ', '', [rfReplaceAll]);

//			if Result = 'NAN' then
//				raise EXStrConvert.Create('Can''t convert float to XStr. Value is NAN');
		finally
			DecimalSeparator := aSaveDecimal;
		end;
	end;
end;

function XStrToExtended(const aValue: String): Variant;
var
	aSaveDecimal: Char;
	aConvertValue: String;
	i: Integer;
begin
	try
		if aValue = XStrNULL then
			Result := Null
		else begin
			aSaveDecimal := DecimalSeparator;
			try
				aConvertValue := aValue;
				i := Pos(',', aConvertValue);
				if i <> 0 then
					aConvertValue[i] := '.';

				DecimalSeparator := '.';
				Result := StrToFloat(aConvertValue);
			finally
				DecimalSeparator := aSaveDecimal;
			end;
		end;
	except
		on E: Exception do
			raise EXStrConvert.CreateFmt('Невозможно сконвертировать XStr-строку "%s" в вещественное значение.'^M^J'Ошибка: %s', [aValue, E.Message]);
	end;
end;

function XStrToExtended(const aValue: String; aNullValue: Extended): Extended;
var
	anExtValue: Variant;
begin
	anExtValue := XStrToExtended(aValue);
	if VarIsNull(anExtValue) then
		Result := aNullValue
	else
		Result := anExtValue;
end;

function CurrencyToXStr(const aValue: Variant): String;
var
	aSaveDecimal: Char;
begin
	if VarIsNull(aValue) or VarIsEmpty(aValue) then
		Result := XStrNULL
	else begin
		aSaveDecimal := DecimalSeparator;
		try
			DecimalSeparator := '.';
			Result := CurrToStr(aValue);
			Result := StringReplace(Result, ' ', '', [rfReplaceAll]);

//			if Result = 'NAN' then
//				raise EXStrConvert.Create('Can''t convert currency to XStr. Value is NAN');
		finally
			DecimalSeparator := aSaveDecimal;
		end
	end;
end;

function XStrToCurrency(const aValue: String): Variant;
begin
	Result := VarAsType_N(XStrToExtended(aValue), varCurrency);
end;

function XStrToCurrency(const aValue: String; aNullValue: Currency): Currency;
var
	aCurrValue: Variant;
begin
	aCurrValue := XStrToCurrency(aValue);
	if VarIsNull(aCurrValue) then
		Result := aNullValue
	else
		Result := aCurrValue;
end;

function BinToXStr(const aValue: Variant): String;
var
	p: Pointer;
begin
	if VarIsNull(aValue) or VarIsEmpty(aValue) then
		Result := XStrNULL
	else begin
		p := VarArrayLock(aValue);
		try
			Result := BinToBase64(p^, VarArrayHighBound(aValue, 1) - VarArrayLowBound(aValue, 1) + 1);
		finally
			VarArrayUnlock(aValue);
		end;
	end;
end;

function XStrToBin(const aValue: String): Variant;
var
	aData: String;
	p: Pointer;
begin
	if aValue = XStrNULL then
		Result := Null
	else begin
		aData := Base64ToBin(aValue);

		Result := VarArrayCreate([0, Length(aData) - 1], varByte);
		p := VarArrayLock(Result);
		try
			Move(aData[1], p^, Length(aData));
		finally
			VarArrayUnlock(Result);
		end;
	end;
end;

end.

