WebSVN – currency_converter – Diff – /trunk/RTL/VtsCurConv.pas


unit VtsCurConv;
 
interface
 
uses
  SysUtils, Classes, Controls;
 
type
  EVtsCurConvException = class(Exception);
 
  TVtsCurApiKey = string;
  TVtsCur = string;
  TVtsRate = double;
 
  TVtsCurConv = class(TObject)
  private
    FSecure: boolean;
    FMaxAgeSeconds: integer;
    FConfirmWebAccess: boolean;
    FFallBackToCache: boolean;
    FInteractiveAPIKeyInput: boolean;
  protected
    function GetJsonRaw(HistoricDate: TDate=0): string;
    procedure QueryAPIKey(msg: string=''); virtual;
  public
    property Secure: boolean read FSecure write FSecure;
    property MaxAgeSeconds: integer read FMaxAgeSeconds write FMaxAgeSeconds;
    property ConfirmWebAccess: boolean read FConfirmWebAccess write FConfirmWebAccess;
    property FallBackToCache: boolean read FFallBackToCache write FFallBackToCache;
    property InteractiveAPIKeyInput: boolean read FInteractiveAPIKeyInput write FInteractiveAPIKeyInput;
    class procedure WriteAPIKey(key: TVtsCurApiKey; UserMode: boolean=true);
    class function ReadAPIKey: TVtsCurApiKey;
    class function DeleteAPIKey(UserMode: boolean=true): boolean;
    function Convert(value: Currency; fromCur, toCur: TVtsCur; HistoricDate: TDate=0): Currency;
    function GetAcceptedCurrencies(sl: TStringList=nil; HistoricDate: TDate=0): integer;
  end;
 
implementation
 
uses
  Windows, Registry, uLkJSON, Dialogs, IdHTTP, DateUtils;
 
function FileGetContents(filename: string): string;
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    sl.LoadFromFile(filename);
    result := sl.Text;
  finally
    sl.Free;
  end;
end;
 
procedure FilePutContents(filename, content: string);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    sl.Text := content;
    sl.SaveToFile(filename);
  finally
    sl.Free;
  end;
end;
 
function GetPage(aURL: string): string;
var
  Response: TStringStream;
  HTTP: TIdHTTP;
const
  HTTP_RESPONSE_OK = 200;
resourcestring
  S_CANNOT_DOWNLOAD = 'Cannot download from %s';
begin
  // https://stackoverflow.com/questions/9239267/how-to-download-a-web-page-into-a-variable
  Result := '';
  Response := TStringStream.Create('');
  try
    HTTP := TIdHTTP.Create(nil);
    try
      HTTP.Get(aURL, Response);
      if HTTP.ResponseCode = HTTP_RESPONSE_OK then
        Result := Response.DataString
      else
        raise EVtsCurConvException.CreateFmt(S_CANNOT_DOWNLOAD, [aURL]);
    finally
      HTTP.Free;
    end;
  finally
    Response.Free;
  end;
end;
 
function GetTempDir: string;
var
  Dir: string;
  Len: DWord;
begin
  SetLength(Dir, MAX_PATH);
  Len := GetTempPath(MAX_PATH, PChar(Dir));
  if Len > 0 then
  begin
    SetLength(Dir, Len);
    Result := Dir;
  end
  else
    RaiseLastOSError;
end;
 
{ TVtsCurConv }
 
class procedure TVtsCurConv.WriteAPIKey(key: TVtsCurApiKey; UserMode: boolean=true);
  procedure _WriteAPIKey(root: HKEY);
  var
    reg: TRegistry;
  resourcestring
    S_CANNOT_OPEN_REGISTRY = 'Cannot open registry key';
  begin
    reg := TRegistry.Create;
    try
      reg.RootKey := root;
      if reg.OpenKey('Software\ViaThinkSoft\CurrencyConverter', true) then
      begin
        reg.WriteString('APIKey', key);
        reg.CloseKey;
      end
      else raise EVtsCurConvException.Create(S_CANNOT_OPEN_REGISTRY);
    finally
      reg.Free;
    end;
  end;
begin
  if UserMode then
    _WriteAPIKey(HKEY_CURRENT_USER)
  else
    _WriteAPIKey(HKEY_LOCAL_MACHINE);
end;
 
class function TVtsCurConv.DeleteAPIKey(UserMode: boolean=true): boolean;
  procedure _DeleteAPIKey(root: HKEY);
  var
    reg: TRegistry;
  begin
    reg := TRegistry.Create;
    try
      reg.RootKey := root;
      if reg.OpenKey('Software\ViaThinkSoft\CurrencyConverter', true) then
      begin
        result := reg.DeleteValue('APIKey');
        reg.CloseKey;
      end;
    finally
      reg.Free;
    end;
  end;
begin
  result := false;
  if UserMode then
    _DeleteAPIKey(HKEY_CURRENT_USER)
  else
    _DeleteAPIKey(HKEY_LOCAL_MACHINE);
end;
 
class function TVtsCurConv.ReadAPIKey: TVtsCurApiKey;
  function _ReadAPIKey(root: HKEY): string;
  var
    reg: TRegistry;
  begin
    result := '';
    reg := TRegistry.Create;
    try
      reg.RootKey := root;
      if reg.OpenKeyReadOnly('Software\ViaThinkSoft\CurrencyConverter') then
      begin
        if reg.ValueExists('APIKey') then result := reg.ReadString('APIKey');
        reg.CloseKey;
      end;
    finally
      reg.Free;
    end;
  end;
begin
  result := _ReadAPIKey(HKEY_CURRENT_USER);
  if result = '' then result := _ReadAPIKey(HKEY_LOCAL_MACHINE);
end;
 
function TVtsCurConv.Convert(value: Currency; fromCur, toCur: TVtsCur; HistoricDate: TDate=0): Currency;
var
  rateTo, rateFrom: TVtsRate;
  i: Integer;
  rateToFound: Boolean;
  rateFromFound: Boolean;
  sJSON: String;
  xSource: TlkJSONstring;
  xRoot: TlkJSONobject;
  xQuotes: TlkJSONobject;
  xRate: TlkJSONnumber;
resourcestring
  S_JSON_ENTRY_MISSING = 'JSON entry "%s" is missing!';
  S_WRONG_QUOTE_LEN = 'Length of quotes-entry is unexpected!';
  S_JSON_RATE_MISSING = 'JSON entry quotes->rate is missing!';
  S_CURRENCY_NOT_SUPPORTED = 'Currency "%s" not supported';
begin
  result := 0; // to avoid that the compiler shows a warning
 
  fromCur := Trim(UpperCase(fromCur));
  toCur := Trim(UpperCase(toCur));
 
  sJSON := GetJsonRaw(HistoricDate);
 
  xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;
  try
    xSource := xRoot.Field['source'] as TlkJSONstring;
    if not assigned(xSource) then raise EVtsCurConvException.CreateFmt(S_JSON_ENTRY_MISSING, ['source']);
 
    xQuotes := xRoot.Field['quotes'] as TlkJSONobject;
    if not assigned(xQuotes) then raise EVtsCurConvException.CreateFmt(S_JSON_ENTRY_MISSING, ['quotes']);
 
    rateToFound := false;
    rateFromFound := false;
    rateTo := 0.00; // to avoid that the compiler shows a warning
    rateFrom := 0.00; // to avoid that the compiler shows a warning
 
    for i := 0 to xQuotes.Count - 1 do
    begin
      if Length(xQuotes.NameOf[i]) <> 6 then raise EVtsCurConvException.Create(S_WRONG_QUOTE_LEN);
 
      xRate := xQuotes.Field[xQuotes.NameOf[i]] as TlkJSONnumber;
      if not Assigned(xRate) then raise EVtsCurConvException.Create(S_JSON_RATE_MISSING);
 
      if Copy(xQuotes.NameOf[i], 1, 3) = xSource.Value then
      begin
        if Copy(xQuotes.NameOf[i], 4, 3) = toCur then
        begin
          rateTo := xRate.Value;
          rateToFound := true;
        end;
        if Copy(xQuotes.NameOf[i], 4, 3) = fromCur then
        begin
          rateFrom := xRate.Value;
          rateFromFound := true;
        end;
      end;
    end;
 
    if not rateToFound then raise EVtsCurConvException.CreateFmt(S_CURRENCY_NOT_SUPPORTED, [toCur]);
    if not rateFromFound then raise EVtsCurConvException.CreateFmt(S_CURRENCY_NOT_SUPPORTED, [fromCur]);
 
    result := value * rateTo / rateFrom;
  finally
    xRoot.Free;
  end;
end;
 
procedure TVtsCurConv.QueryAPIKey(msg: string='');
var
  s: string;
resourcestring
  S_CURRENCYLAYER = 'currencylayer.com';
  S_ENTER_KEY = 'Please enter your API key:';
  S_NO_API_KEY = 'No API key provided.';
begin
  s := Trim(InputBox(S_CURRENCYLAYER, Trim(msg + ' ' + S_ENTER_KEY), ''));
  if s = '' then raise EVtsCurConvException.Create(S_NO_API_KEY);
  WriteAPIKey(s);
end;
 
function TVtsCurConv.GetAcceptedCurrencies(sl: TStringList=nil; HistoricDate: TDate=0): integer;
var
  i: Integer;
  sJSON: String;
  xSource: TlkJSONstring;
  xRoot: TlkJSONobject;
  xQuotes: TlkJSONobject;
resourcestring
  S_JSON_ENTRY_MISSING = 'JSON entry "%s" is missing!';
  S_WRONG_QUOTE_LEN = 'Length of quotes-entry is unexpected!';
begin
  result := 0;
 
  sJSON := GetJsonRaw(HistoricDate);
 
  xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;
  try
    xSource := xRoot.Field['source'] as TlkJSONstring;
    if not assigned(xSource) then raise EVtsCurConvException.CreateFmt(S_JSON_ENTRY_MISSING, ['source']);
 
    xQuotes := xRoot.Field['quotes'] as TlkJSONobject;
    if not assigned(xQuotes) then raise EVtsCurConvException.CreateFmt(S_JSON_ENTRY_MISSING, ['quotes']);
 
    for i := 0 to xQuotes.Count - 1 do
    begin
      if Length(xQuotes.NameOf[i]) <> 6 then raise EVtsCurConvException.Create(S_WRONG_QUOTE_LEN);
 
      if Copy(xQuotes.NameOf[i], 1, 3) = xSource.Value then
      begin
        Inc(result);
        if Assigned(sl) then sl.Add(Copy(xQuotes.NameOf[i], 4, 3));
      end;
    end;
  finally
    xRoot.Free;
  end;
end;
 
function TVtsCurConv.GetJsonRaw(HistoricDate: TDate=0): string;
 
  procedure _HandleKeyInvalidOrMissing(cacheFileName: string; msg: string; out doRetry: boolean; out json: string);
  resourcestring
    S_ENTER_NEW_KEY = 'Do you want to enter a new one?';
  begin
    if FallBackToCache then
    begin
      if not InteractiveAPIKeyInput then
      begin
        json := FileGetContents(cacheFileName);
        doRetry := false;
      end
      else
      begin
        if MessageDlg(Trim(msg + ' ' + S_ENTER_NEW_KEY), mtError, mbYesNoCancel, 0) = ID_YES then
        begin
          QueryAPIKey;
          doRetry := true;
        end
        else
        begin
          json := FileGetContents(cacheFileName);
          doRetry := false;
        end;
      end;
    end
    else // if not FallBackToCache then
    begin
      if not InteractiveAPIKeyInput then
      begin
        raise EVtsCurConvException.Create(msg);
      end
      else
      begin
        QueryAPIKey(msg);
        doRetry := true;
      end;
    end;
  end;
 
var
  sJSON, msg, protocol: string;
  xRoot: TlkJSONobject;
  xSuccess: TlkJSONboolean;
  keyInvalid, doRetry: boolean;
  sDate: string;
  url: string;
  cacheDirName, cacheFileName: string;
  needDownload: boolean;
  mTime: TDateTime;
resourcestring
  S_CANNOT_CREATE_DIR = 'Cannot create directory %s';
  S_INVALID_MAXAGE = 'Invalid maxage';
  S_NO_API_KEY_PROVIDED = 'No API key provided.';
  S_DOWNLOAD_QUERY = 'Download %s to %s ?';
  S_JSON_FILE_INVALID = 'JSON file invalid';
  S_UNKNOWN_SUCCESS = 'Cannot determinate status of the query.';
  S_JSON_UNKNOWN_ERROR = 'Unknown error while loading JSON.';
  S_API_KEY_INVALID = 'API key invalid.';
begin
  try
    {$REGION 'Determinate file location and URL'}
    // cacheDirName := IncludeTrailingPathDelimiter(GetSpecialPath(CSIDL_PROGRAM_FILES_COMMON)) + 'ViaThinkSoft\CurrencyConverter\';
    cacheDirName := IncludeTrailingPathDelimiter(GetTempDir) + 'ViaThinkSoft\CurrencyConverter\';
    if not ForceDirectories(cacheDirName) then
    begin
      raise EVtsCurConvException.CreateFmt(S_CANNOT_CREATE_DIR, [cacheDirName]);
    end;
 
    if Secure then protocol := 'https' else protocol := 'http';
    if HistoricDate = 0 then
    begin
      sDate := '';
      url := protocol + '://www.apilayer.net/api/live?access_key=' + ReadAPIKey;
      cacheFileName := IncludeTrailingPathDelimiter(cacheDirName) + 'live.json';
    end
    else
    begin
      DateTimeToString(sDate, 'YYYY-MM-DD', HistoricDate);
      url := protocol + '://www.apilayer.net/api/historical?date=' + sDate + '&access_key=' + ReadAPIKey;
      cacheFileName := IncludeTrailingPathDelimiter(cacheDirName) + 'historical-' + sDate + '.json';
    end;
    {$ENDREGION}
 
    {$REGION 'Determinate if we need to download or not'}
    if HistoricDate = 0 then
    begin
      needDownload := true;
      if MaxAgeSeconds < -1 then
      begin
        raise EVtsCurConvException.Create(S_INVALID_MAXAGE);
      end
      else if MaxAgeSeconds = -1 then
      begin
        // Only download once
        needDownload := not FileExists(cacheFileName);
      end
      else if MaxAgeSeconds = 0 then
      begin
        // Always download
        needDownload := true;
      end
      else if MaxAgeSeconds > 0 then
      begin
        // Download if older than <MaxAge> seconds
        FileAge(cacheFileName, mTime);
        needDownload := not FileExists(cacheFileName) or (SecondsBetween(Now, mTime) > MaxAgeSeconds);
      end;
    end
    else
    begin
      needDownload := not FileExists(cacheFileName)
    end;
    {$ENDREGION}
 
    if not needDownload then
    begin
      sJSON := FileGetContents(cacheFileName);
    end
    else
    begin
      doRetry := false;
 
      {$REGION 'Is an API key available?'}
      if ReadAPIKey = '' then
      begin
        _HandleKeyInvalidOrMissing(cacheFileName, S_NO_API_KEY_PROVIDED, doRetry, sJSON);
        if not doRetry then
        begin
          result := sJSON;
          Exit;
        end;
      end;
      {$ENDREGION}
 
      {$REGION 'Download and check if everything is OK'}
      repeat
        {$REGION 'Confirm web access?'}
        if ConfirmWebAccess and (MessageDlg(Format(S_DOWNLOAD_QUERY, [url, cacheFileName]), mtConfirmation, mbYesNoCancel, 0) <> ID_YES) then
        begin
          if FallBackToCache then
          begin
            result := FileGetContents(cacheFileName);
            Exit;
          end
          else Abort;
        end;
        {$ENDREGION}
 
        doRetry := false;
 
        sJSON := GetPage(url);
 
        xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;
        if not assigned(xRoot) then raise EVtsCurConvException.Create(S_JSON_FILE_INVALID);
 
        xSuccess := xRoot.Field['success'] as TlkJSONboolean;
        if not assigned(xSuccess) then raise EVtsCurConvException.Create(S_UNKNOWN_SUCCESS);
 
        if xSuccess.Value then
        begin
          try
            FilePutContents(cacheFileName, sJSON);
          except
            // Since this is only a cache, we should not break the whole process if only the saving fails
          end;
        end
        else
        begin
          {$REGION 'Get information of the error'}
          try
            keyInvalid := xRoot.Field['error'].Field['code'].Value = 101;
            msg := Format('%s (%s, %s)', [
              xRoot.Field['error'].Field['info'].Value,
              xRoot.Field['error'].Field['code'].Value,
              xRoot.Field['error'].Field['type'].Value]);
          except
            keyInvalid := false;
            msg := S_JSON_UNKNOWN_ERROR;
          end;
          {$ENDREGION}
 
          if keyInvalid then
          begin
            _HandleKeyInvalidOrMissing(cacheFileName, S_API_KEY_INVALID, doRetry, sJSON);
          end
          else // if not keyInvalid then
          begin
            if FallBackToCache then
            begin
              result := FileGetContents(cacheFileName);
              Exit;
            end
            else
            begin
              raise EVtsCurConvException.Create(msg);
            end;
          end;
        end;
      until not doRetry;
      {$ENDREGION}
    end;
 
    result := sJSON;
  finally
    FreeAndNil(xRoot);
  end;
end;
 
end.
 

Rev 2	Rev 13
1	unit VtsCurConv;	1	unit VtsCurConv;
2		2
3	interface	3	interface
4		4
5	uses	5	uses
6	SysUtils, Classes, Controls;	6	SysUtils, Classes, Controls;
7		7
8	type	8	type
9	EVtsCurConvException = class(Exception);	9	EVtsCurConvException = class(Exception);
10		10
11	TVtsCurApiKey = string;	11	TVtsCurApiKey = string;
12	TVtsCur = string;	12	TVtsCur = string;
13	TVtsRate = double;	13	TVtsRate = double;
14		14
15	TVtsCurConv = class(TObject)	15	TVtsCurConv = class(TObject)
16	private	16	private
17	FSecure: boolean;	17	FSecure: boolean;
18	FMaxAgeSeconds: integer;	18	FMaxAgeSeconds: integer;
19	FConfirmWebAccess: boolean;	19	FConfirmWebAccess: boolean;
20	FFallBackToCache: boolean;	20	FFallBackToCache: boolean;
21	FInteractiveAPIKeyInput: boolean;	21	FInteractiveAPIKeyInput: boolean;
22	protected	22	protected
23	function GetJsonRaw(HistoricDate: TDate=0): string;	23	function GetJsonRaw(HistoricDate: TDate=0): string;
24	procedure QueryAPIKey(msg: string=''); virtual;	24	procedure QueryAPIKey(msg: string=''); virtual;
25	public	25	public
26	property Secure: boolean read FSecure write FSecure;	26	property Secure: boolean read FSecure write FSecure;
27	property MaxAgeSeconds: integer read FMaxAgeSeconds write FMaxAgeSeconds;	27	property MaxAgeSeconds: integer read FMaxAgeSeconds write FMaxAgeSeconds;
28	property ConfirmWebAccess: boolean read FConfirmWebAccess write FConfirmWebAccess;	28	property ConfirmWebAccess: boolean read FConfirmWebAccess write FConfirmWebAccess;
29	property FallBackToCache: boolean read FFallBackToCache write FFallBackToCache;	29	property FallBackToCache: boolean read FFallBackToCache write FFallBackToCache;
30	property InteractiveAPIKeyInput: boolean read FInteractiveAPIKeyInput write FInteractiveAPIKeyInput;	30	property InteractiveAPIKeyInput: boolean read FInteractiveAPIKeyInput write FInteractiveAPIKeyInput;
31	class procedure WriteAPIKey(key: TVtsCurApiKey; UserMode: boolean=true);	31	class procedure WriteAPIKey(key: TVtsCurApiKey; UserMode: boolean=true);
32	class function ReadAPIKey: TVtsCurApiKey;	32	class function ReadAPIKey: TVtsCurApiKey;
33	class function DeleteAPIKey(UserMode: boolean=true): boolean;	33	class function DeleteAPIKey(UserMode: boolean=true): boolean;
34	function Convert(value: Currency; fromCur, toCur: TVtsCur; HistoricDate: TDate=0): Currency;	34	function Convert(value: Currency; fromCur, toCur: TVtsCur; HistoricDate: TDate=0): Currency;
35	function GetAcceptedCurrencies(sl: TStringList=nil; HistoricDate: TDate=0): integer;	35	function GetAcceptedCurrencies(sl: TStringList=nil; HistoricDate: TDate=0): integer;
36	end;	36	end;
37		37
38	implementation	38	implementation
39		39
40	uses	40	uses
41	Windows, Registry, uLkJSON, Dialogs, IdHTTP, DateUtils;	41	Windows, Registry, uLkJSON, Dialogs, IdHTTP, DateUtils;
42		42
43	function FileGetContents(filename: string): string;	43	function FileGetContents(filename: string): string;
44	var	44	var
45	sl: TStringList;	45	sl: TStringList;
46	begin	46	begin
47	sl := TStringList.Create;	47	sl := TStringList.Create;
48	try	48	try
49	sl.LoadFromFile(filename);	49	sl.LoadFromFile(filename);
50	result := sl.Text;	50	result := sl.Text;
51	finally	51	finally
52	sl.Free;	52	sl.Free;
53	end;	53	end;
54	end;	54	end;
55		55
56	procedure FilePutContents(filename, content: string);	56	procedure FilePutContents(filename, content: string);
57	var	57	var
58	sl: TStringList;	58	sl: TStringList;
59	begin	59	begin
60	sl := TStringList.Create;	60	sl := TStringList.Create;
61	try	61	try
62	sl.Text := content;	62	sl.Text := content;
63	sl.SaveToFile(filename);	63	sl.SaveToFile(filename);
64	finally	64	finally
65	sl.Free;	65	sl.Free;
66	end;	66	end;
67	end;	67	end;
68		68
69	function GetPage(aURL: string): string;	69	function GetPage(aURL: string): string;
70	var	70	var
71	Response: TStringStream;	71	Response: TStringStream;
72	HTTP: TIdHTTP;	72	HTTP: TIdHTTP;
73	const	73	const
74	HTTP_RESPONSE_OK = 200;	74	HTTP_RESPONSE_OK = 200;
-		75	resourcestring
-		76	S_CANNOT_DOWNLOAD = 'Cannot download from %s';
75	begin	77	begin
76	// https://stackoverflow.com/questions/9239267/how-to-download-a-web-page-into-a-variable	78	// https://stackoverflow.com/questions/9239267/how-to-download-a-web-page-into-a-variable
77	Result := '';	79	Result := '';
78	Response := TStringStream.Create('');	80	Response := TStringStream.Create('');
79	try	81	try
80	HTTP := TIdHTTP.Create(nil);	82	HTTP := TIdHTTP.Create(nil);
81	try	83	try
82	HTTP.Get(aURL, Response);	84	HTTP.Get(aURL, Response);
83	if HTTP.ResponseCode = HTTP_RESPONSE_OK then	85	if HTTP.ResponseCode = HTTP_RESPONSE_OK then
84	Result := Response.DataString	86	Result := Response.DataString
85	else	87	else
86	raise EVtsCurConvException.CreateFmt('Cannot download from %s', [aURL]);	88	raise EVtsCurConvException.CreateFmt(S_CANNOT_DOWNLOAD, [aURL]);
87	finally	89	finally
88	HTTP.Free;	90	HTTP.Free;
89	end;	91	end;
90	finally	92	finally
91	Response.Free;	93	Response.Free;
92	end;	94	end;
93	end;	95	end;
94		96
95	function GetTempDir: string;	97	function GetTempDir: string;
96	var	98	var
97	Dir: string;	99	Dir: string;
98	Len: DWord;	100	Len: DWord;
99	begin	101	begin
100	SetLength(Dir, MAX_PATH);	102	SetLength(Dir, MAX_PATH);
101	Len := GetTempPath(MAX_PATH, PChar(Dir));	103	Len := GetTempPath(MAX_PATH, PChar(Dir));
102	if Len > 0 then	104	if Len > 0 then
103	begin	105	begin
104	SetLength(Dir, Len);	106	SetLength(Dir, Len);
105	Result := Dir;	107	Result := Dir;
106	end	108	end
107	else	109	else
108	RaiseLastOSError;	110	RaiseLastOSError;
109	end;	111	end;
110		112
111	{ TVtsCurConv }	113	{ TVtsCurConv }
112		114
113	class procedure TVtsCurConv.WriteAPIKey(key: TVtsCurApiKey; UserMode: boolean=true);	115	class procedure TVtsCurConv.WriteAPIKey(key: TVtsCurApiKey; UserMode: boolean=true);
114	procedure _WriteAPIKey(root: HKEY);	116	procedure _WriteAPIKey(root: HKEY);
115	var	117	var
116	reg: TRegistry;	118	reg: TRegistry;
-		119	resourcestring
-		120	S_CANNOT_OPEN_REGISTRY = 'Cannot open registry key';
117	begin	121	begin
118	reg := TRegistry.Create;	122	reg := TRegistry.Create;
119	try	123	try
120	reg.RootKey := root;	124	reg.RootKey := root;
121	if reg.OpenKey('Software\ViaThinkSoft\CurrencyConverter', true) then	125	if reg.OpenKey('Software\ViaThinkSoft\CurrencyConverter', true) then
122	begin	126	begin
123	reg.WriteString('APIKey', key);	127	reg.WriteString('APIKey', key);
124	reg.CloseKey;	128	reg.CloseKey;
125	end	129	end
126	else raise EVtsCurConvException.Create('Cannot open registry key');	130	else raise EVtsCurConvException.Create(S_CANNOT_OPEN_REGISTRY);
127	finally	131	finally
128	reg.Free;	132	reg.Free;
129	end;	133	end;
130	end;	134	end;
131	begin	135	begin
132	if UserMode then	136	if UserMode then
133	_WriteAPIKey(HKEY_CURRENT_USER)	137	_WriteAPIKey(HKEY_CURRENT_USER)
134	else	138	else
135	_WriteAPIKey(HKEY_LOCAL_MACHINE);	139	_WriteAPIKey(HKEY_LOCAL_MACHINE);
136	end;	140	end;
137		141
138	class function TVtsCurConv.DeleteAPIKey(UserMode: boolean=true): boolean;	142	class function TVtsCurConv.DeleteAPIKey(UserMode: boolean=true): boolean;
139	procedure _DeleteAPIKey(root: HKEY);	143	procedure _DeleteAPIKey(root: HKEY);
140	var	144	var
141	reg: TRegistry;	145	reg: TRegistry;
142	begin	146	begin
143	reg := TRegistry.Create;	147	reg := TRegistry.Create;
144	try	148	try
145	reg.RootKey := root;	149	reg.RootKey := root;
146	if reg.OpenKey('Software\ViaThinkSoft\CurrencyConverter', true) then	150	if reg.OpenKey('Software\ViaThinkSoft\CurrencyConverter', true) then
147	begin	151	begin
148	result := reg.DeleteValue('APIKey');	152	result := reg.DeleteValue('APIKey');
149	reg.CloseKey;	153	reg.CloseKey;
150	end;	154	end;
151	finally	155	finally
152	reg.Free;	156	reg.Free;
153	end;	157	end;
154	end;	158	end;
155	begin	159	begin
156	result := false;	160	result := false;
157	if UserMode then	161	if UserMode then
158	_DeleteAPIKey(HKEY_CURRENT_USER)	162	_DeleteAPIKey(HKEY_CURRENT_USER)
159	else	163	else
160	_DeleteAPIKey(HKEY_LOCAL_MACHINE);	164	_DeleteAPIKey(HKEY_LOCAL_MACHINE);
161	end;	165	end;
162		166
163	class function TVtsCurConv.ReadAPIKey: TVtsCurApiKey;	167	class function TVtsCurConv.ReadAPIKey: TVtsCurApiKey;
164	function _ReadAPIKey(root: HKEY): string;	168	function _ReadAPIKey(root: HKEY): string;
165	var	169	var
166	reg: TRegistry;	170	reg: TRegistry;
167	begin	171	begin
168	result := '';	172	result := '';
169	reg := TRegistry.Create;	173	reg := TRegistry.Create;
170	try	174	try
171	reg.RootKey := root;	175	reg.RootKey := root;
172	if reg.OpenKeyReadOnly('Software\ViaThinkSoft\CurrencyConverter') then	176	if reg.OpenKeyReadOnly('Software\ViaThinkSoft\CurrencyConverter') then
173	begin	177	begin
174	if reg.ValueExists('APIKey') then result := reg.ReadString('APIKey');	178	if reg.ValueExists('APIKey') then result := reg.ReadString('APIKey');
175	reg.CloseKey;	179	reg.CloseKey;
176	end;	180	end;
177	finally	181	finally
178	reg.Free;	182	reg.Free;
179	end;	183	end;
180	end;	184	end;
181	begin	185	begin
182	result := _ReadAPIKey(HKEY_CURRENT_USER);	186	result := _ReadAPIKey(HKEY_CURRENT_USER);
183	if result = '' then result := _ReadAPIKey(HKEY_LOCAL_MACHINE);	187	if result = '' then result := _ReadAPIKey(HKEY_LOCAL_MACHINE);
184	end;	188	end;
185		189
186	function TVtsCurConv.Convert(value: Currency; fromCur, toCur: TVtsCur; HistoricDate: TDate=0): Currency;	190	function TVtsCurConv.Convert(value: Currency; fromCur, toCur: TVtsCur; HistoricDate: TDate=0): Currency;
187	var	191	var
188	rateTo, rateFrom: TVtsRate;	192	rateTo, rateFrom: TVtsRate;
189	i: Integer;	193	i: Integer;
190	rateToFound: Boolean;	194	rateToFound: Boolean;
191	rateFromFound: Boolean;	195	rateFromFound: Boolean;
192	sJSON: String;	196	sJSON: String;
193	xSource: TlkJSONstring;	197	xSource: TlkJSONstring;
194	xRoot: TlkJSONobject;	198	xRoot: TlkJSONobject;
195	xQuotes: TlkJSONobject;	199	xQuotes: TlkJSONobject;
196	xRate: TlkJSONnumber;	200	xRate: TlkJSONnumber;
-		201	resourcestring
-		202	S_JSON_ENTRY_MISSING = 'JSON entry "%s" is missing!';
-		203	S_WRONG_QUOTE_LEN = 'Length of quotes-entry is unexpected!';
-		204	S_JSON_RATE_MISSING = 'JSON entry quotes->rate is missing!';
-		205	S_CURRENCY_NOT_SUPPORTED = 'Currency "%s" not supported';
197	begin	206	begin
198	result := 0; // to avoid that the compiler shows a warning	207	result := 0; // to avoid that the compiler shows a warning
199		208
200	fromCur := Trim(UpperCase(fromCur));	209	fromCur := Trim(UpperCase(fromCur));
201	toCur := Trim(UpperCase(toCur));	210	toCur := Trim(UpperCase(toCur));
202		211
203	sJSON := GetJsonRaw(HistoricDate);	212	sJSON := GetJsonRaw(HistoricDate);
204		213
205	xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;	214	xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;
206	try	215	try
207	xSource := xRoot.Field['source'] as TlkJSONstring;	216	xSource := xRoot.Field['source'] as TlkJSONstring;
208	if not assigned(xSource) then raise EVtsCurConvException.Create('JSON entry "source" is missing!');	217	if not assigned(xSource) then raise EVtsCurConvException.CreateFmt(S_JSON_ENTRY_MISSING, ['source']);
209		218
210	xQuotes := xRoot.Field['quotes'] as TlkJSONobject;	219	xQuotes := xRoot.Field['quotes'] as TlkJSONobject;
211	if not assigned(xQuotes) then raise EVtsCurConvException.Create('JSON entry "quotes" is missing!');	220	if not assigned(xQuotes) then raise EVtsCurConvException.CreateFmt(S_JSON_ENTRY_MISSING, ['quotes']);
212		221
213	rateToFound := false;	222	rateToFound := false;
214	rateFromFound := false;	223	rateFromFound := false;
215	rateTo := 0.00; // to avoid that the compiler shows a warning	224	rateTo := 0.00; // to avoid that the compiler shows a warning
216	rateFrom := 0.00; // to avoid that the compiler shows a warning	225	rateFrom := 0.00; // to avoid that the compiler shows a warning
217		226
218	for i := 0 to xQuotes.Count - 1 do	227	for i := 0 to xQuotes.Count - 1 do
219	begin	228	begin
220	if Length(xQuotes.NameOf[i]) <> 6 then raise EVtsCurConvException.Create('Length of quotes-entry is unexpected!');	229	if Length(xQuotes.NameOf[i]) <> 6 then raise EVtsCurConvException.Create(S_WRONG_QUOTE_LEN);
221		230
222	xRate := xQuotes.Field[xQuotes.NameOf[i]] as TlkJSONnumber;	231	xRate := xQuotes.Field[xQuotes.NameOf[i]] as TlkJSONnumber;
223	if not Assigned(xRate) then raise EVtsCurConvException.Create('JSON entry quotes->rate is missing!');	232	if not Assigned(xRate) then raise EVtsCurConvException.Create(S_JSON_RATE_MISSING);
224		233
225	if Copy(xQuotes.NameOf[i], 1, 3) = xSource.Value then	234	if Copy(xQuotes.NameOf[i], 1, 3) = xSource.Value then
226	begin	235	begin
227	if Copy(xQuotes.NameOf[i], 4, 3) = toCur then	236	if Copy(xQuotes.NameOf[i], 4, 3) = toCur then
228	begin	237	begin
229	rateTo := xRate.Value;	238	rateTo := xRate.Value;
230	rateToFound := true;	239	rateToFound := true;
231	end;	240	end;
232	if Copy(xQuotes.NameOf[i], 4, 3) = fromCur then	241	if Copy(xQuotes.NameOf[i], 4, 3) = fromCur then
233	begin	242	begin
234	rateFrom := xRate.Value;	243	rateFrom := xRate.Value;
235	rateFromFound := true;	244	rateFromFound := true;
236	end;	245	end;
237	end;	246	end;
238	end;	247	end;
239		248
240	if not rateToFound then raise EVtsCurConvException.CreateFmt('Currency "%s" not supported', [toCur]);	249	if not rateToFound then raise EVtsCurConvException.CreateFmt(S_CURRENCY_NOT_SUPPORTED, [toCur]);
241	if not rateFromFound then raise EVtsCurConvException.CreateFmt('Currency "%s" not supported', [fromCur]);	250	if not rateFromFound then raise EVtsCurConvException.CreateFmt(S_CURRENCY_NOT_SUPPORTED, [fromCur]);
242		251
243	result := value * rateTo / rateFrom;	252	result := value * rateTo / rateFrom;
244	finally	253	finally
245	xRoot.Free;	254	xRoot.Free;
246	end;	255	end;
247	end;	256	end;
248		257
249	procedure TVtsCurConv.QueryAPIKey(msg: string='');	258	procedure TVtsCurConv.QueryAPIKey(msg: string='');
250	var	259	var
251	s: string;	260	s: string;
-		261	resourcestring
-		262	S_CURRENCYLAYER = 'currencylayer.com';
-		263	S_ENTER_KEY = 'Please enter your API key:';
-		264	S_NO_API_KEY = 'No API key provided.';
252	begin	265	begin
253	s := Trim(InputBox('currencylayer.com', Trim(msg + ' Please enter your API key:'), ''));	266	s := Trim(InputBox(S_CURRENCYLAYER, Trim(msg + ' ' + S_ENTER_KEY), ''));
254	if s = '' then raise EVtsCurConvException.Create('No API key provided.');	267	if s = '' then raise EVtsCurConvException.Create(S_NO_API_KEY);
255	WriteAPIKey(s);	268	WriteAPIKey(s);
256	end;	269	end;
257		270
258	function TVtsCurConv.GetAcceptedCurrencies(sl: TStringList=nil; HistoricDate: TDate=0): integer;	271	function TVtsCurConv.GetAcceptedCurrencies(sl: TStringList=nil; HistoricDate: TDate=0): integer;
259	var	272	var
260	i: Integer;	273	i: Integer;
261	sJSON: String;	274	sJSON: String;
262	xSource: TlkJSONstring;	275	xSource: TlkJSONstring;
263	xRoot: TlkJSONobject;	276	xRoot: TlkJSONobject;
264	xQuotes: TlkJSONobject;	277	xQuotes: TlkJSONobject;
-		278	resourcestring
-		279	S_JSON_ENTRY_MISSING = 'JSON entry "%s" is missing!';
-		280	S_WRONG_QUOTE_LEN = 'Length of quotes-entry is unexpected!';
265	begin	281	begin
266	result := 0;	282	result := 0;
267		283
268	sJSON := GetJsonRaw(HistoricDate);	284	sJSON := GetJsonRaw(HistoricDate);
269		285
270	xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;	286	xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;
271	try	287	try
272	xSource := xRoot.Field['source'] as TlkJSONstring;	288	xSource := xRoot.Field['source'] as TlkJSONstring;
273	if not assigned(xSource) then raise EVtsCurConvException.Create('JSON entry "source" is missing!');	289	if not assigned(xSource) then raise EVtsCurConvException.CreateFmt(S_JSON_ENTRY_MISSING, ['source']);
274		290
275	xQuotes := xRoot.Field['quotes'] as TlkJSONobject;	291	xQuotes := xRoot.Field['quotes'] as TlkJSONobject;
276	if not assigned(xQuotes) then raise EVtsCurConvException.Create('JSON entry "quotes" is missing!');	292	if not assigned(xQuotes) then raise EVtsCurConvException.CreateFmt(S_JSON_ENTRY_MISSING, ['quotes']);
277		293
278	for i := 0 to xQuotes.Count - 1 do	294	for i := 0 to xQuotes.Count - 1 do
279	begin	295	begin
280	if Length(xQuotes.NameOf[i]) <> 6 then raise EVtsCurConvException.Create('Length of quotes-entry is unexpected!');	296	if Length(xQuotes.NameOf[i]) <> 6 then raise EVtsCurConvException.Create(S_WRONG_QUOTE_LEN);
281		297
282	if Copy(xQuotes.NameOf[i], 1, 3) = xSource.Value then	298	if Copy(xQuotes.NameOf[i], 1, 3) = xSource.Value then
283	begin	299	begin
284	Inc(result);	300	Inc(result);
285	if Assigned(sl) then sl.Add(Copy(xQuotes.NameOf[i], 4, 3));	301	if Assigned(sl) then sl.Add(Copy(xQuotes.NameOf[i], 4, 3));
286	end;	302	end;
287	end;	303	end;
288	finally	304	finally
289	xRoot.Free;	305	xRoot.Free;
290	end;	306	end;
291	end;	307	end;
292		308
293	function TVtsCurConv.GetJsonRaw(HistoricDate: TDate=0): string;	309	function TVtsCurConv.GetJsonRaw(HistoricDate: TDate=0): string;
294		310
295	procedure _HandleKeyInvalidOrMissing(cacheFileName: string; msg: string; out doRetry: boolean; out json: string);	311	procedure _HandleKeyInvalidOrMissing(cacheFileName: string; msg: string; out doRetry: boolean; out json: string);
-		312	resourcestring
-		313	S_ENTER_NEW_KEY = 'Do you want to enter a new one?';
296	begin	314	begin
297	if FallBackToCache then	315	if FallBackToCache then
298	begin	316	begin
299	if not InteractiveAPIKeyInput then	317	if not InteractiveAPIKeyInput then
300	begin	318	begin
301	json := FileGetContents(cacheFileName);	319	json := FileGetContents(cacheFileName);
302	doRetry := false;	320	doRetry := false;
303	end	321	end
304	else	322	else
305	begin	323	begin
306	if MessageDlg(Trim(msg + ' Do you want to enter a new one?'), mtError, mbYesNoCancel, 0) = ID_YES then	324	if MessageDlg(Trim(msg + ' ' + S_ENTER_NEW_KEY), mtError, mbYesNoCancel, 0) = ID_YES then
307	begin	325	begin
308	QueryAPIKey;	326	QueryAPIKey;
309	doRetry := true;	327	doRetry := true;
310	end	328	end
311	else	329	else
312	begin	330	begin
313	json := FileGetContents(cacheFileName);	331	json := FileGetContents(cacheFileName);
314	doRetry := false;	332	doRetry := false;
315	end;	333	end;
316	end;	334	end;
317	end	335	end
318	else // if not FallBackToCache then	336	else // if not FallBackToCache then
319	begin	337	begin
320	if not InteractiveAPIKeyInput then	338	if not InteractiveAPIKeyInput then
321	begin	339	begin
322	raise EVtsCurConvException.Create(msg);	340	raise EVtsCurConvException.Create(msg);
323	end	341	end
324	else	342	else
325	begin	343	begin
326	QueryAPIKey(msg);	344	QueryAPIKey(msg);
327	doRetry := true;	345	doRetry := true;
328	end;	346	end;
329	end;	347	end;
330	end;	348	end;
331		349
332	var	350	var
333	sJSON, msg, protocol: string;	351	sJSON, msg, protocol: string;
334	xRoot: TlkJSONobject;	352	xRoot: TlkJSONobject;
335	xSuccess: TlkJSONboolean;	353	xSuccess: TlkJSONboolean;
336	keyInvalid, doRetry: boolean;	354	keyInvalid, doRetry: boolean;
337	sDate: string;	355	sDate: string;
338	url: string;	356	url: string;
339	cacheDirName, cacheFileName: string;	357	cacheDirName, cacheFileName: string;
340	needDownload: boolean;	358	needDownload: boolean;
341	mTime: TDateTime;	359	mTime: TDateTime;
-		360	resourcestring
-		361	S_CANNOT_CREATE_DIR = 'Cannot create directory %s';
-		362	S_INVALID_MAXAGE = 'Invalid maxage';
-		363	S_NO_API_KEY_PROVIDED = 'No API key provided.';
-		364	S_DOWNLOAD_QUERY = 'Download %s to %s ?';
-		365	S_JSON_FILE_INVALID = 'JSON file invalid';
-		366	S_UNKNOWN_SUCCESS = 'Cannot determinate status of the query.';
-		367	S_JSON_UNKNOWN_ERROR = 'Unknown error while loading JSON.';
-		368	S_API_KEY_INVALID = 'API key invalid.';
342	begin	369	begin
343	try	370	try
344	{$REGION 'Determinate file location and URL'}	371	{$REGION 'Determinate file location and URL'}
345	// cacheDirName := IncludeTrailingPathDelimiter(GetSpecialPath(CSIDL_PROGRAM_FILES_COMMON)) + 'ViaThinkSoft\CurrencyConverter\';	372	// cacheDirName := IncludeTrailingPathDelimiter(GetSpecialPath(CSIDL_PROGRAM_FILES_COMMON)) + 'ViaThinkSoft\CurrencyConverter\';
346	cacheDirName := IncludeTrailingPathDelimiter(GetTempDir) + 'ViaThinkSoft\CurrencyConverter\';	373	cacheDirName := IncludeTrailingPathDelimiter(GetTempDir) + 'ViaThinkSoft\CurrencyConverter\';
347	if not ForceDirectories(cacheDirName) then	374	if not ForceDirectories(cacheDirName) then
348	begin	375	begin
349	raise EVtsCurConvException.CreateFmt('Cannot create directory %s', [cacheDirName]);	376	raise EVtsCurConvException.CreateFmt(S_CANNOT_CREATE_DIR, [cacheDirName]);
350	end;	377	end;
351		378
352	if Secure then protocol := 'https' else protocol := 'http';	379	if Secure then protocol := 'https' else protocol := 'http';
353	if HistoricDate = 0 then	380	if HistoricDate = 0 then
354	begin	381	begin
355	sDate := '';	382	sDate := '';
356	url := protocol + '://www.apilayer.net/api/live?access_key=' + ReadAPIKey;	383	url := protocol + '://www.apilayer.net/api/live?access_key=' + ReadAPIKey;
357	cacheFileName := IncludeTrailingPathDelimiter(cacheDirName) + 'live.json';	384	cacheFileName := IncludeTrailingPathDelimiter(cacheDirName) + 'live.json';
358	end	385	end
359	else	386	else
360	begin	387	begin
361	DateTimeToString(sDate, 'YYYY-MM-DD', HistoricDate);	388	DateTimeToString(sDate, 'YYYY-MM-DD', HistoricDate);
362	url := protocol + '://www.apilayer.net/api/historical?date=' + sDate + '&access_key=' + ReadAPIKey;	389	url := protocol + '://www.apilayer.net/api/historical?date=' + sDate + '&access_key=' + ReadAPIKey;
363	cacheFileName := IncludeTrailingPathDelimiter(cacheDirName) + 'historical-' + sDate + '.json';	390	cacheFileName := IncludeTrailingPathDelimiter(cacheDirName) + 'historical-' + sDate + '.json';
364	end;	391	end;
365	{$ENDREGION}	392	{$ENDREGION}
366		393
367	{$REGION 'Determinate if we need to download or not'}	394	{$REGION 'Determinate if we need to download or not'}
368	if HistoricDate = 0 then	395	if HistoricDate = 0 then
369	begin	396	begin
370	needDownload := true;	397	needDownload := true;
371	if MaxAgeSeconds < -1 then	398	if MaxAgeSeconds < -1 then
372	begin	399	begin
373	raise EVtsCurConvException.Create('Invalid maxage');	400	raise EVtsCurConvException.Create(S_INVALID_MAXAGE);
374	end	401	end
375	else if MaxAgeSeconds = -1 then	402	else if MaxAgeSeconds = -1 then
376	begin	403	begin
377	// Only download once	404	// Only download once
378	needDownload := not FileExists(cacheFileName);	405	needDownload := not FileExists(cacheFileName);
379	end	406	end
380	else if MaxAgeSeconds = 0 then	407	else if MaxAgeSeconds = 0 then
381	begin	408	begin
382	// Always download	409	// Always download
383	needDownload := true;	410	needDownload := true;
384	end	411	end
385	else if MaxAgeSeconds > 0 then	412	else if MaxAgeSeconds > 0 then
386	begin	413	begin
387	// Download if older than <MaxAge> seconds	414	// Download if older than <MaxAge> seconds
388	FileAge(cacheFileName, mTime);	415	FileAge(cacheFileName, mTime);
389	needDownload := not FileExists(cacheFileName) or (SecondsBetween(Now, mTime) > MaxAgeSeconds);	416	needDownload := not FileExists(cacheFileName) or (SecondsBetween(Now, mTime) > MaxAgeSeconds);
390	end;	417	end;
391	end	418	end
392	else	419	else
393	begin	420	begin
394	needDownload := not FileExists(cacheFileName)	421	needDownload := not FileExists(cacheFileName)
395	end;	422	end;
396	{$ENDREGION}	423	{$ENDREGION}
397		424
398	if not needDownload then	425	if not needDownload then
399	begin	426	begin
400	sJSON := FileGetContents(cacheFileName);	427	sJSON := FileGetContents(cacheFileName);
401	end	428	end
402	else	429	else
403	begin	430	begin
404	doRetry := false;	431	doRetry := false;
405		432
406	{$REGION 'Is an API key available?'}	433	{$REGION 'Is an API key available?'}
407	if ReadAPIKey = '' then	434	if ReadAPIKey = '' then
408	begin	435	begin
409	_HandleKeyInvalidOrMissing(cacheFileName, 'No API key provided.', doRetry, sJSON);	436	_HandleKeyInvalidOrMissing(cacheFileName, S_NO_API_KEY_PROVIDED, doRetry, sJSON);
410	if not doRetry then	437	if not doRetry then
411	begin	438	begin
412	result := sJSON;	439	result := sJSON;
413	Exit;	440	Exit;
414	end;	441	end;
415	end;	442	end;
416	{$ENDREGION}	443	{$ENDREGION}
417		444
418	{$REGION 'Download and check if everything is OK'}	445	{$REGION 'Download and check if everything is OK'}
419	repeat	446	repeat
420	{$REGION 'Confirm web access?'}	447	{$REGION 'Confirm web access?'}
421	if ConfirmWebAccess and (MessageDlg('Download ' + url + ' to ' + cacheFileName + ' ?', mtConfirmation, mbYesNoCancel, 0) <> ID_YES) then	448	if ConfirmWebAccess and (MessageDlg(Format(S_DOWNLOAD_QUERY, [url, cacheFileName]), mtConfirmation, mbYesNoCancel, 0) <> ID_YES) then
422	begin	449	begin
423	if FallBackToCache then	450	if FallBackToCache then
424	begin	451	begin
425	result := FileGetContents(cacheFileName);	452	result := FileGetContents(cacheFileName);
426	Exit;	453	Exit;
427	end	454	end
428	else Abort;	455	else Abort;
429	end;	456	end;
430	{$ENDREGION}	457	{$ENDREGION}
431		458
432	doRetry := false;	459	doRetry := false;
433		460
434	sJSON := GetPage(url);	461	sJSON := GetPage(url);
435		462
436	xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;	463	xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;
437	if not assigned(xRoot) then raise EVtsCurConvException.Create('JSON file invalid');	464	if not assigned(xRoot) then raise EVtsCurConvException.Create(S_JSON_FILE_INVALID);
438		465
439	xSuccess := xRoot.Field['success'] as TlkJSONboolean;	466	xSuccess := xRoot.Field['success'] as TlkJSONboolean;
440	if not assigned(xSuccess) then raise EVtsCurConvException.Create('Cannot determinate status of the query.');	467	if not assigned(xSuccess) then raise EVtsCurConvException.Create(S_UNKNOWN_SUCCESS);
441		468
442	if xSuccess.Value then	469	if xSuccess.Value then
443	begin	470	begin
444	try	471	try
445	FilePutContents(cacheFileName, sJSON);	472	FilePutContents(cacheFileName, sJSON);
446	except	473	except
447	// Since this is only a cache, we should not break the whole process if only the saving fails	474	// Since this is only a cache, we should not break the whole process if only the saving fails
448	end;	475	end;
449	end	476	end
450	else	477	else
451	begin	478	begin
452	{$REGION 'Get information of the error'}	479	{$REGION 'Get information of the error'}
453	try	480	try
454	keyInvalid := xRoot.Field['error'].Field['code'].Value = 101;	481	keyInvalid := xRoot.Field['error'].Field['code'].Value = 101;
455	msg := Format('%s (%s, %s)', [	482	msg := Format('%s (%s, %s)', [
456	xRoot.Field['error'].Field['info'].Value,	483	xRoot.Field['error'].Field['info'].Value,
457	xRoot.Field['error'].Field['code'].Value,	484	xRoot.Field['error'].Field['code'].Value,
458	xRoot.Field['error'].Field['type'].Value]);	485	xRoot.Field['error'].Field['type'].Value]);
459	except	486	except
460	keyInvalid := false;	487	keyInvalid := false;
461	msg := 'Unknown error while loading JSON.';	488	msg := S_JSON_UNKNOWN_ERROR;
462	end;	489	end;
463	{$ENDREGION}	490	{$ENDREGION}
464		491
465	if keyInvalid then	492	if keyInvalid then
466	begin	493	begin
467	_HandleKeyInvalidOrMissing(cacheFileName, 'API key invalid.', doRetry, sJSON);	494	_HandleKeyInvalidOrMissing(cacheFileName, S_API_KEY_INVALID, doRetry, sJSON);
468	end	495	end
469	else // if not keyInvalid then	496	else // if not keyInvalid then
470	begin	497	begin
471	if FallBackToCache then	498	if FallBackToCache then
472	begin	499	begin
473	result := FileGetContents(cacheFileName);	500	result := FileGetContents(cacheFileName);

Subversion Repositories currency_converter

currency_converter/trunk/RTL/VtsCurConv.pas – Rev 2 → 13