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

Subversion Repositories currency_converter

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