ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/branches/journaling/fbintf/IBUtils.pas

Comparing ibx/trunk/fbintf/IBUtils.pas (file contents):
Revision 287 by tony, Thu Apr 11 08:51:23 2019 UTC vs.
Revision 356 by tony, Sun Oct 24 14:00:52 2021 UTC

#	Line 39 | Line 39 | unit IBUtils;
39		{$IFDEF FPC}
40		{$Mode Delphi}
41		{$codepage UTF8}
42	–	{$define HASREQEX}
42		{$ENDIF}
43
44	+	{ $IF declared(CompilerVersion) and (CompilerVersion >= 22)}
45	+	{ $define HASDELPHIREQEX}
46	+	{ $IFEND}
47
48		interface
49
#	Line 634 | Line 636 | function ParseConnectString(ConnectStrin
636		var PortNo: AnsiString): boolean;
637		function GetProtocol(ConnectString: AnsiString): TProtocolAll;
638
639	+	{$IF declared(TFormatSettings)}
640	+	function ParseDateTimeTZString(aDateTimeStr: Ansistring; var aDateTime: TDateTime;
641	+	var aTimezone: AnsiString; aFormatSettings: TFormatSettings; TimeOnly: boolean=false): boolean; overload;
642	+	{$IFEND}
643	+	function ParseDateTimeTZString(aDateTimeStr: Ansistring; var aDateTime: TDateTime;
644	+	var aTimezone: AnsiString; TimeOnly: boolean=false): boolean;  overload;
645	+	procedure FBDecodeTime(aTime: TDateTime; var Hour, Minute, Second: word; var DeciMillisecond: cardinal);
646	+	function FBEncodeTime(Hour, Minute, Second, DeciMillisecond: cardinal): TDateTime;
647	+	function FBFormatDateTime(fmt: AnsiString; aDateTime: TDateTime): AnsiString;
648	+	function FormatTimeZoneOffset(EffectiveTimeOffsetMins: integer): AnsiString;
649	+	function DecodeTimeZoneOffset(TZOffset: AnsiString; var dstOffset: integer): boolean;
650	+	function StripLeadingZeros(Value: AnsiString): AnsiString;
651	+	function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean;
652	+	function NumericToDouble(aValue: Int64; aScale: integer): double;
653	+
654	+
655		implementation
656
657	<	uses FBMessages
657	>	uses FBMessages, Math
658
659	<	{$IFDEF HASREQEX}
659	>	{$IFDEF FPC}
660		,RegExpr
661	+	{$ELSE}
662	+	{$IF declared(CompilerVersion) and (CompilerVersion >= 22)}
663	+	, RegularExpressions
664	+	{$IFEND}
665		{$ENDIF};
666
667	+
668		function Max(n1, n2: Integer): Integer;
669		begin
670		if (n1 > n2) then
#	Line 737 | Line 760 | end;
760
761		function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
762		begin
763	+	Value := TrimRight(Value);
764		if Dialect = 1 then
765	<	Value := AnsiUpperCase(Trim(Value))
765	>	Value := AnsiUpperCase(Value)
766		else
767		Value := '"' + StringReplace (Value, '""', '"', [rfReplaceAll]) + '"';
768		Result := Value;
#	Line 758 | Line 782 | begin
782		Result := true;
783		end;
784
785	+	function SchemeToProtocol(scheme: AnsiString): TProtocolAll;
786	+	begin
787	+	scheme := AnsiUpperCase(scheme);
788	+	if scheme = 'INET' then
789	+	Result := inet
790	+	else
791	+	if scheme = 'INET4' then
792	+	Result := inet4
793	+	else
794	+	if scheme = 'INET6' then
795	+	Result := inet6
796	+	else
797	+	if scheme = 'XNET' then
798	+	Result := xnet
799	+	else
800	+	if scheme = 'WNET' then
801	+	Result := wnet
802	+	end;
803	+
804		{Extracts the Database Connect string from a Create Database Statement}
805
806	<	{$IFDEF HASREQEX}
806	>	{$IF declared(TRegexpr)}
807		function ExtractConnectString(const CreateSQL: AnsiString;
808		var ConnectString: AnsiString): boolean;
809		var RegexObj: TRegExpr;
#	Line 783 | Line 826 | function ParseConnectString(ConnectStrin
826		DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
827		): boolean;
828
786	–	function GetProtocol(scheme: AnsiString): TProtocolAll;
787	–	begin
788	–	scheme := AnsiUpperCase(scheme);
789	–	if scheme = 'INET' then
790	–	Result := inet
791	–	else
792	–	if scheme = 'INET4' then
793	–	Result := inet4
794	–	else
795	–	if scheme = 'INET6' then
796	–	Result := inet6
797	–	else
798	–	if scheme = 'XNET' then
799	–	Result := xnet
800	–	else
801	–	if scheme = 'WNET' then
802	–	Result := wnet
803	–	end;
804	–
829		var RegexObj: TRegExpr;
830		begin
831		ServerName := '';
#	Line 817 | Line 841 | begin
841		if Result then
842		begin
843		{URL type connect string}
844	<	Protocol := GetProtocol(RegexObj.Match[1]);
844	>	Protocol := SchemeToProtocol(RegexObj.Match[1]);
845		ServerName := RegexObj.Match[2];
846		if RegexObj.MatchLen[3] > 0 then
847		PortNo := system.Copy(ConnectString,RegexObj.MatchPos[3]+1,RegexObj.MatchLen[3]-1);
#	Line 832 | Line 856 | begin
856		Result := RegexObj.Exec(ConnectString);
857		if Result then
858		begin
859	<	Protocol := GetProtocol(RegexObj.Match[1]);
859	>	Protocol := SchemeToProtocol(RegexObj.Match[1]);
860		DatabaseName := RegexObj.Match[2];
861		end
862		else
#	Line 881 | Line 905 | begin
905		end;
906		end;
907
908	<	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
909	<	var ServerName,
910	<	DatabaseName: AnsiString;
911	<	PortNo: AnsiString;
908	>	{$ELSE}
909	>	{$IF declared(TRegex)}
910	>	function ExtractConnectString(const CreateSQL: AnsiString;
911	>	var ConnectString: AnsiString): boolean;
912	>	var Regex: TRegEx;
913	>	Match: TMatch;
914		begin
915	<	ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo);
915	>	Regex := TRegEx.Create('^ *CREATE +(DATABASE|SCHEMA) +''(.*)''',[roIgnoreCase]);
916	>	{extact database file spec}
917	>	Match := Regex.Match(CreateSQL);
918	>	Result := Match.Success and (Match.Groups.Count = 3);
919	>	if Result then
920	>	ConnectString := Match.Groups[2].Value;
921		end;
922
923	+	function ParseConnectString(ConnectString: AnsiString; var ServerName,
924	+	DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
925	+	): boolean;
926	+
927	+	var Regex: TRegEx;
928	+	Match: TMatch;
929	+	begin
930	+	ServerName := '';
931	+	DatabaseName := ConnectString;
932	+	PortNo := '';
933	+	Protocol := unknownProtocol;
934	+	{extact database file spec}
935	+	Match := Regex.Match(ConnectString,'^([a-zA-Z46]+)://([a-zA-Z0-9\-\.]*)(|:[0-9a-zA-Z\-]+)/(.*)$',[roIgnoreCase]);
936	+	Result := Match.Success and (Match.Groups.Count = 5);
937	+	if Result then
938	+	begin
939	+	{URL type connect string}
940	+	Protocol := SchemeToProtocol(Match.Groups[1].Value);
941	+	ServerName := Match.Groups[2].Value;
942	+	PortNo := Match.Groups[3].Value;
943	+	DatabaseName := Match.Groups[4].Value;
944	+	if ServerName = '' then
945	+	DatabaseName := '/' + DatabaseName;
946	+	end
947	+	else
948	+	begin
949	+	{URL type connect string - local loop}
950	+	Match := Regex.Match(ConnectString,'^([a-zA-Z46]+)://(.*)$',[roIgnoreCase]);
951	+	Result := Match.Success and (Match.Groups.Count = 3);
952	+	if Result then
953	+	begin
954	+	Protocol := SchemeToProtocol(Match.Groups[1].Value);
955	+	DatabaseName := Match.Groups[2].Value;
956	+	end
957	+	else
958	+	begin
959	+	Match := Regex.Match(ConnectString,'^([a-zA-Z]:\\.*)',[roIgnoreCase]);
960	+	Result := Match.Success;
961	+	if Result then
962	+	Protocol := Local {Windows with leading drive ID}
963	+	else
964	+	begin
965	+	Match := Regex.Match(ConnectString,'^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$',[roIgnoreCase]);
966	+	Result := Match.Success and (Match.Groups.Count = 4);
967	+	if Result then
968	+	begin
969	+	{Legacy TCP Format}
970	+	ServerName := Match.Groups[1].Value;
971	+	PortNo := Match.Groups[2].Value;
972	+	DatabaseName := Match.Groups[3].Value;
973	+	Protocol := TCP;
974	+	end
975	+	else
976	+	begin
977	+	Match := Regex.Match(ConnectString,'^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$',[roIgnoreCase]);
978	+	Result := Match.Success and (Match.Groups.Count = 4);
979	+	if Result then
980	+	begin
981	+	{Netbui}
982	+	ServerName := Match.Groups[1].Value;
983	+	PortNo := Match.Groups[2].Value;
984	+	DatabaseName := Match.Groups[3].Value;
985	+	Protocol := NamedPipe
986	+	end
987	+	else
988	+	begin
989	+	Result := true;
990	+	Protocol := Local; {Assume local}
991	+	end;
992	+	end;
993	+	end;
994	+	end;
995	+	end;
996	+	end;
997		{$ELSE}
998	<	{cruder version of above for Delphi. Older versions lack regular expression
998	>	{cruder version of above for Delphi < XE. Older versions lack regular expression
999		handling.}
1000		function ExtractConnectString(const CreateSQL: AnsiString;
1001		var ConnectString: AnsiString): boolean;
#	Line 911 | Line 1016 | begin
1016		end;
1017		end;
1018
914	–	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
915	–	begin
916	–	Result := unknownProtocol; {not implemented for Delphi}
917	–	end;
918	–
1019		function ParseConnectString(ConnectString: AnsiString;
1020		var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
1021		var PortNo: AnsiString): boolean;
#	Line 923 | Line 1023 | begin
1023		Result := false;
1024		end;
1025
1026	<	{$ENDIF}
1026	>	{$IFEND}
1027	>	{$IFEND}
1028	>
1029	>	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
1030	>	var ServerName,
1031	>	DatabaseName: AnsiString;
1032	>	PortNo: AnsiString;
1033	>	begin
1034	>	if not ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo) then
1035	>	Result := unknownProtocol;
1036	>	end;
1037
1038		{Make a connect string in format appropriate protocol}
1039
#	Line 939 | Line 1049 | function MakeConnectString(ServerName, D
1049		end;
1050
1051		begin
1052	+	if ServerName = '' then ServerName := 'localhost';
1053		if PortNo <> '' then
1054		case Protocol of
1055		NamedPipe:
#	Line 969 | Line 1080 | end;
1080
1081		function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
1082		begin
1083	+	Value := TrimRight(Value);
1084		if (Dialect = 3) and
1085		(IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
1086		Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
#	Line 1140 | Line 1252 | begin
1252		stInBlock:
1253		begin
1254		case token of
1255	<	sqltBegin:
1255	>	sqltBegin,
1256	>	sqltCase:
1257		Inc(FNested);
1258
1259		sqltEnd:
#	Line 1362 | Line 1475 | begin
1475		GetNext;
1476
1477		repeat
1478	+	if FSkipNext then
1479	+	begin
1480	+	FSkipNext := false;
1481	+	GetNext;
1482	+	end;
1483	+
1484		Result := FNextToken;
1485		C := FLastChar;
1486		GetNext;
1487
1488	<	if FSkipNext then
1488	>	if (Result = sqltCR) and (FNextToken = sqltEOL) then
1489		begin
1490	<	FSkipNext := false;
1491	<	continue;
1490	>	FSkipNext := true;
1491	>	Result := sqltEOL;
1492	>	C := LF;
1493		end;
1494
1495		case FState of
#	Line 1382 | Line 1502 | begin
1502		GetNext;
1503		end
1504		else
1505	+	if Result = sqltEOL then
1506	+	FString := FString + LineEnding
1507	+	else
1508		FString := FString + C;
1509		end;
1510
#	Line 1394 | Line 1517 | begin
1517		Result := sqltCommentLine;
1518		end;
1519
1397	–	sqltCR: {ignore};
1398	–
1520		else
1521		FString := FString + C;
1522		end;
#	Line 1417 | Line 1538 | begin
1538		end;
1539		end
1540		else
1541	+	if Result = sqltEOL then
1542	+	FString := FString + LineEnding
1543	+	else
1544		FString := FString + C;
1545		end;
1546
#	Line 1436 | Line 1560 | begin
1560		end;
1561		end
1562		else
1563	+	if Result = sqltEOL then
1564	+	FString := FString + LineEnding
1565	+	else
1566		FString := FString + C;
1567		end;
1568
#	Line 1516 | Line 1643 | begin
1643		sqltNumberString:
1644		if FNextToken in [sqltNumberString,sqltPeriod] then
1645		FState := stInNumeric;
1646	+
1647	+	sqltEOL:
1648	+	FString := LineEnding;
1649		end;
1650		end;
1651		end;
#	Line 1525 | Line 1655 | begin
1655		until TokenFound(Result) or EOF;
1656		end;
1657
1658	+	function ParseDateTimeTZString(aDateTimeStr: Ansistring; var aDateTime: TDateTime;
1659	+	var aTimezone: AnsiString; TimeOnly: boolean): boolean;
1660	+	{$IF declared(TFormatSettings)}
1661	+	begin
1662	+	{$IF declared(DefaultFormatSettings)}
1663	+	Result := ParseDateTimeTZString(aDateTimeStr,aDateTime,aTimeZone,DefaultFormatSettings,TimeOnly);
1664	+	{$ELSE}
1665	+	{$IF declared(FormatSettings)}
1666	+	Result := ParseDateTimeTZString(aDateTimeStr,aDateTime,aTimeZone,FormatSettings,TimeOnly);
1667	+	{$IFEND} {$IFEND}
1668	+	end;
1669	+
1670	+	function ParseDateTimeTZString(aDateTimeStr: Ansistring; var aDateTime: TDateTime;
1671	+	var aTimezone: AnsiString; aFormatSettings: TFormatSettings; TimeOnly: boolean=false): boolean;
1672	+	{$IFEND}
1673	+	const
1674	+	whitespacechars = [' ',#$09,#$0A,#$0D];
1675	+	var i,j,l: integer;
1676	+	aTime: TDateTime;
1677	+	DMs: longint;
1678	+	begin
1679	+	Result := false;
1680	+	aTimezone := '';
1681	+	if aDateTimeStr <> '' then
1682	+	{$if declared(TFormatSettings)}
1683	+	with aFormatSettings do
1684	+	{$IFEND}
1685	+	begin
1686	+	aDateTime := 0;
1687	+	{Parse to get time zone info}
1688	+	i := 1;
1689	+	while (i <= length(aDateTimeStr)) and (aDateTimeStr[i] in whitespacechars) do inc(i); {skip white space}
1690	+	if not TimeOnly then
1691	+	begin
1692	+	{decode date}
1693	+	j := i;
1694	+	while (j <= length(aDateTimeStr)) and (aDateTimeStr[j] in ['0'..'9',DateSeparator]) do inc(j);
1695	+	if TryStrToDate(system.copy(aDateTimeStr,i,j-i),aDateTime) then
1696	+	i := j; {otherwise start again i.e. assume time only}
1697	+	end;
1698	+
1699	+	while (i <= length(aDateTimeStr)) and (aDateTimeStr[i] in whitespacechars) do inc(i); {skip white space}
1700	+	{decode time}
1701	+	j := i;
1702	+	while (j <= length(aDateTimeStr)) and (aDateTimeStr[j] in ['0'..'9',TimeSeparator]) do inc(j);
1703	+	Result := TryStrToTime(system.copy(aDateTimeStr,i,j-i),aTime);
1704	+	if not Result then Exit;
1705	+	aDateTime := aDateTime + aTime;
1706	+	i := j;
1707	+
1708	+	{is there a factional second part}
1709	+	if (i <= length(aDateTimeStr)) and (aDateTimeStr[i] = '.') then
1710	+	begin
1711	+	inc(i);
1712	+	inc(j);
1713	+	while (j <= Length(aDateTimeStr)) and (aDateTimeStr[j] in ['0'..'9']) do inc(j);
1714	+	if j > i then
1715	+	begin
1716	+	l := j-i;
1717	+	if l > 4 then l := 4;
1718	+	Result := TryStrToInt(system.copy(aDateTimeStr,i,l),DMs);
1719	+	if not Result then Exit;
1720	+
1721	+	{adjust for number of significant digits}
1722	+	case l of
1723	+	3:   DMs := DMs * 10;
1724	+	2:   DMs := DMs * 100;
1725	+	1:   DMs := DMs * 1000;
1726	+	end;
1727	+	aDateTime := aDateTime + (DMs / (MsecsPerDay*10));
1728	+	end;
1729	+	end;
1730	+	i := j;
1731	+
1732	+	while (i <= length(aDateTimeStr)) and (aDateTimeStr[i] in whitespacechars) do inc(i); {skip white space}
1733	+	{decode time zone}
1734	+	if i < length(aDateTimeStr) then
1735	+	begin
1736	+	j := i;
1737	+	while (j <= length(aDateTimeStr)) and not (aDateTimeStr[j] in whitespacechars) do inc(j);
1738	+	aTimezone := system.copy(aDateTimeStr,i,j-i);
1739	+	end;
1740	+	Result := true;
1741	+	end
1742	+	end;
1743	+
1744	+	{The following is similar to FPC DecodeTime except that the Firebird standard
1745	+	decimilliseconds is used instead of milliseconds for fractional seconds}
1746	+
1747	+	procedure FBDecodeTime(aTime: TDateTime; var Hour, Minute, Second: word;
1748	+	var DeciMillisecond: cardinal);
1749	+	var D : Double;
1750	+	l : cardinal;
1751	+	begin
1752	+	{conversion to decimilliseconds hacked from FPC DateTimeToTimeStamp}
1753	+	D := aTime * MSecsPerDay *10;
1754	+	if D < 0 then
1755	+	D := D - 0.5
1756	+	else
1757	+	D := D + 0.5;
1758	+	{rest hacked from FPC DecodeTIme}
1759	+	l := Abs(Trunc(D)) Mod (MSecsPerDay*10);
1760	+	Hour   := l div 36000000;
1761	+	l := l mod 36000000;
1762	+	Minute := l div 600000;
1763	+	l := l mod 600000;
1764	+	Second := l div 10000;
1765	+	DeciMillisecond := l mod 10000;
1766	+	end;
1767	+
1768	+	{The following is similar to FPC EncodeTime except that the Firebird standard
1769	+	decimilliseconds is used instead of milliseconds for fractional seconds}
1770	+
1771	+	function FBEncodeTime(Hour, Minute, Second, DeciMillisecond: cardinal): TDateTime;
1772	+	const DMSecsPerDay = MSecsPerDay*10;
1773	+	var DMs: cardinal;
1774	+	D: Double;
1775	+	begin
1776	+	if (Hour<24) and (Minute<60) and (Second<60) and (DeciMillisecond<10000) then
1777	+	begin
1778	+	DMs := Hour*36000000+Minute*600000+Second*10000+DeciMillisecond;
1779	+	D := DMs/DMSecsPerDay;
1780	+	Result:=TDateTime(d)
1781	+	end
1782	+	else
1783	+	IBError(ibxeBadTimeSpecification,[Hour, Minute, Second, DeciMillisecond]);
1784	+	end;
1785	+
1786	+	{The following is similar to FPC FormatDateTime except that it additionally
1787	+	allows the timstamp to have a fractional seconds component with a resolution
1788	+	of four decimal places. This is appended to the result for FormatDateTime
1789	+	if the format string contains a "zzzz' string.}
1790	+
1791	+	function FBFormatDateTime(fmt: AnsiString; aDateTime: TDateTime): AnsiString;
1792	+	var Hour, Minute, Second: word;
1793	+	DeciMillisecond: cardinal;
1794	+	begin
1795	+	if Pos('zzzz',fmt) > 0 then
1796	+	begin
1797	+	FBDecodeTime(aDateTime, Hour, Minute, Second, DeciMillisecond);
1798	+	fmt := StringReplace(fmt, 'zzzz', Format('%.4d',[DeciMillisecond]), [rfReplaceAll]);
1799	+	end;
1800	+	Result := FormatDateTime(fmt,aDateTime);
1801	+	end;
1802	+
1803	+	function FormatTimeZoneOffset(EffectiveTimeOffsetMins: integer): AnsiString;
1804	+	begin
1805	+	if EffectiveTimeOffsetMins > 0 then
1806	+	Result := Format('+%.2d:%.2d',[EffectiveTimeOffsetMins div 60,abs(EffectiveTimeOffsetMins mod 60)])
1807	+	else
1808	+	Result := Format('%.2d:%.2d',[EffectiveTimeOffsetMins div 60,abs(EffectiveTimeOffsetMins mod 60)]);
1809	+	end;
1810	+
1811	+	function DecodeTimeZoneOffset(TZOffset: AnsiString; var dstOffset: integer): boolean;
1812	+	var i: integer;
1813	+	begin
1814	+	Result := false;
1815	+	TZOffset := Trim(TZOffset);
1816	+	for i := 1 to Length(TZOffset) do
1817	+	if not (TZOffset[i] in ['0'..'9','-','+',':']) then Exit;
1818	+
1819	+	Result := true;
1820	+	i := Pos(':',TZOffset);
1821	+	if i > 0 then
1822	+	dstOffset := StrToInt(copy(TZOffset,1,i-1)) * 60 + StrToInt(copy(TZOffset,i + 1))
1823	+	else
1824	+	dstOffset := StrToInt(TZOffset) * 60;
1825	+	end;
1826	+
1827	+	function StripLeadingZeros(Value: AnsiString): AnsiString;
1828	+	var i: Integer;
1829	+	start: integer;
1830	+	begin
1831	+	Result := '';
1832	+	start := 1;
1833	+	if (Length(Value) > 0) and (Value[1] = '-') then
1834	+	begin
1835	+	Result := '-';
1836	+	start := 2;
1837	+	end;
1838	+	for i := start to Length(Value) do
1839	+	if Value[i] <> '0' then
1840	+	begin
1841	+	Result := Result + system.copy(Value, i, MaxInt);
1842	+	Exit;
1843	+	end;
1844	+	end;
1845	+
1846	+	function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean;
1847	+	var i: integer;
1848	+	ds: integer;
1849	+	exponent: integer;
1850	+	begin
1851	+	Result := false;
1852	+	ds := 0;
1853	+	exponent := 0;
1854	+	S := Trim(S);
1855	+	Value := 0;
1856	+	scale := 0;
1857	+	if Length(S) = 0 then
1858	+	Exit;
1859	+	{$IF declared(DefaultFormatSettings)}
1860	+	with DefaultFormatSettings do
1861	+	{$ELSE}
1862	+	{$IF declared(FormatSettings)}
1863	+	with FormatSettings do
1864	+	{$IFEND}
1865	+	{$IFEND}
1866	+	begin
1867	+	for i := length(S) downto 1 do
1868	+	begin
1869	+	if S[i] = AnsiChar(DecimalSeparator) then
1870	+	begin
1871	+	if ds <> 0 then Exit; {only one allowed}
1872	+	ds := i;
1873	+	dec(exponent);
1874	+	system.Delete(S,i,1);
1875	+	end
1876	+	else
1877	+	if S[i] in ['+','-'] then
1878	+	begin
1879	+	if (i > 1) and not (S[i-1] in ['e','E']) then
1880	+	Exit; {malformed}
1881	+	end
1882	+	else
1883	+	if S[i] in ['e','E'] then {scientific notation}
1884	+	begin
1885	+	if ds <> 0 then Exit; {not permitted in exponent}
1886	+	if exponent <> 0 then Exit; {only one allowed}
1887	+	exponent := i;
1888	+	end
1889	+	else
1890	+	if not (S[i] in ['0'..'9']) then
1891	+	{Note: ThousandSeparator not allowed by Delphi specs}
1892	+	Exit; {bad character}
1893	+	end;
1894	+
1895	+	if exponent > 0 then
1896	+	begin
1897	+	Result := TryStrToInt(system.copy(S,exponent+1,maxint),Scale);
1898	+	if Result then
1899	+	begin
1900	+	{adjust scale for decimal point}
1901	+	if ds <> 0 then
1902	+	Scale := Scale - (exponent - ds);
1903	+	Result := TryStrToInt64(system.copy(S,1,exponent-1),Value);
1904	+	end;
1905	+	end
1906	+	else
1907	+	begin
1908	+	if ds <> 0 then
1909	+	scale := ds - Length(S) - 1;
1910	+	Result := TryStrToInt64(S,Value);
1911	+	end;
1912	+	end;
1913	+	end;
1914	+
1915	+	function NumericToDouble(aValue: Int64; aScale: integer): double;
1916	+	begin
1917	+	Result := aValue * IntPower(10,aScale)
1918	+	end;
1919	+
1920		end.

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines