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


unit VtsCurConv;
 
interface
 
uses
  SysUtils, Classes;
 
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?';
    S_NO_CACHE_EXISTING = 'Cannot get the data online, and no cache exists. Please check your internet connection and API key.';
  begin
    if FallBackToCache then
    begin
      if not InteractiveAPIKeyInput then
      begin
        if not FileExists(cacheFileName) then
        begin
          raise Exception.Create(S_NO_CACHE_EXISTING);
        end;
        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
          if not FileExists(cacheFileName) then
          begin
            raise Exception.Create(S_NO_CACHE_EXISTING);
          end;
          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;
 
  function protocol: string;
  begin
    if Secure then result := 'https' else result := 'http';
  end;
 
  function url: string;
  var
    sDate: string;
  begin
    if HistoricDate = 0 then
    begin
      sDate := '';
      result := protocol + '://www.apilayer.net/api/live?access_key=' + ReadAPIKey;
    end
    else
    begin
      DateTimeToString(sDate, 'YYYY-MM-DD', HistoricDate);
      result := protocol + '://www.apilayer.net/api/historical?date=' + sDate + '&access_key=' + ReadAPIKey;
    end;
  end;
 
  function cacheFileName: string;
  resourcestring
    S_CANNOT_CREATE_DIR = 'Cannot create directory %s';
  var
    sDate: string;
    cacheDirName: string;
  begin
    // 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 HistoricDate = 0 then
    begin
      sDate := '';
      result := IncludeTrailingPathDelimiter(cacheDirName) + 'live.json';
    end
    else
    begin
      DateTimeToString(sDate, 'YYYY-MM-DD', HistoricDate);
      result := IncludeTrailingPathDelimiter(cacheDirName) + 'historical-' + sDate + '.json';
    end;
  end;
 
var
  sJSON, msg: string;
  xRoot: TlkJSONobject;
  xSuccess: TlkJSONboolean;
  keyInvalid, doRetry: boolean;
  needDownload: boolean;
  mTime: TDateTime;
resourcestring
  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
  {$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 and FileExists(cacheFileName) 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 and FileExists(cacheFileName) 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);
      try
        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 and FileExists(cacheFileName) then
            begin
              result := FileGetContents(cacheFileName);
              Exit;
            end
            else
            begin
              raise EVtsCurConvException.Create(msg);
            end;
          end;
        end;
      finally
        FreeAndNil(xRoot);
      end;
    until not doRetry;
    {$ENDREGION}
  end;
 
  result := sJSON;
 
  // "USDUSD" missing 06 Aug 2022. A bug?? Reported https://github.com/apilayer/currencylayer-API/issues/16
  if Pos('"USDUSD"', result) = 0 then
    result := StringReplace(result, '"quotes":{', '"quotes":{"USDUSD":1.00,', []);
end;
 
end.
 

Rev 19	Rev 22
1	unit VtsCurConv;	1	unit VtsCurConv;
2		2
3	interface	3	interface
4		4
5	uses	5	uses
6	SysUtils, Classes;	6	SysUtils, Classes;
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	212	if fromCur = toCur then
213	begin	213	begin
214	result := value;	214	result := value;
215	exit;	215	exit;
216	end;	216	end;
217		217
218	sJSON := GetJsonRaw(HistoricDate);	218	sJSON := GetJsonRaw(HistoricDate);
219		219
220	xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;	220	xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;
221	try	221	try
222	xSource := xRoot.Field['source'] as TlkJSONstring;	222	xSource := xRoot.Field['source'] as TlkJSONstring;
223	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']);
224		224
225	xQuotes := xRoot.Field['quotes'] as TlkJSONobject;	225	xQuotes := xRoot.Field['quotes'] as TlkJSONobject;
226	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']);
227		227
228	rateToFound := false;	228	rateToFound := false;
229	rateFromFound := false;	229	rateFromFound := false;
230	rateTo := 0.00; // to avoid that the compiler shows a warning	230	rateTo := 0.00; // to avoid that the compiler shows a warning
231	rateFrom := 0.00; // to avoid that the compiler shows a warning	231	rateFrom := 0.00; // to avoid that the compiler shows a warning
232		232
233	for i := 0 to xQuotes.Count - 1 do	233	for i := 0 to xQuotes.Count - 1 do
234	begin	234	begin
235	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);
236		236
237	xRate := xQuotes.Field[xQuotes.NameOf[i]] as TlkJSONnumber;	237	xRate := xQuotes.Field[xQuotes.NameOf[i]] as TlkJSONnumber;
238	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);
239		239
240	if Copy(xQuotes.NameOf[i], 1, 3) = xSource.Value then	240	if Copy(xQuotes.NameOf[i], 1, 3) = xSource.Value then
241	begin	241	begin
242	if Copy(xQuotes.NameOf[i], 4, 3) = toCur then	242	if Copy(xQuotes.NameOf[i], 4, 3) = toCur then
243	begin	243	begin
244	rateTo := xRate.Value;	244	rateTo := xRate.Value;
245	rateToFound := true;	245	rateToFound := true;
246	end;	246	end;
247	if Copy(xQuotes.NameOf[i], 4, 3) = fromCur then	247	if Copy(xQuotes.NameOf[i], 4, 3) = fromCur then
248	begin	248	begin
249	rateFrom := xRate.Value;	249	rateFrom := xRate.Value;
250	rateFromFound := true;	250	rateFromFound := true;
251	end;	251	end;
252	end;	252	end;
253	end;	253	end;
254		254
255	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]);
256	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]);
257		257
258	result := value * rateTo / rateFrom;	258	result := value * rateTo / rateFrom;
259	finally	259	finally
260	xRoot.Free;	260	xRoot.Free;
261	end;	261	end;
262	end;	262	end;
263		263
264	procedure TVtsCurConv.QueryAPIKey(msg: string='');	264	procedure TVtsCurConv.QueryAPIKey(msg: string='');
265	var	265	var
266	s: string;	266	s: string;
267	resourcestring	267	resourcestring
268	S_CURRENCYLAYER = 'currencylayer.com';	268	S_CURRENCYLAYER = 'currencylayer.com';
269	S_ENTER_KEY = 'Please enter your API key:';	269	S_ENTER_KEY = 'Please enter your API key:';
270	S_NO_API_KEY = 'No API key provided.';	270	S_NO_API_KEY = 'No API key provided.';
271	begin	271	begin
272	s := Trim(InputBox(S_CURRENCYLAYER, Trim(msg + ' ' + S_ENTER_KEY), ''));	272	s := Trim(InputBox(S_CURRENCYLAYER, Trim(msg + ' ' + S_ENTER_KEY), ''));
273	if s = '' then raise EVtsCurConvException.Create(S_NO_API_KEY);	273	if s = '' then raise EVtsCurConvException.Create(S_NO_API_KEY);
274	WriteAPIKey(s);	274	WriteAPIKey(s);
275	end;	275	end;
276		276
277	function TVtsCurConv.GetAcceptedCurrencies(sl: TStringList=nil; HistoricDate: TDate=0): integer;	277	function TVtsCurConv.GetAcceptedCurrencies(sl: TStringList=nil; HistoricDate: TDate=0): integer;
278	var	278	var
279	i: Integer;	279	i: Integer;
280	sJSON: String;	280	sJSON: String;
281	xSource: TlkJSONstring;	281	xSource: TlkJSONstring;
282	xRoot: TlkJSONobject;	282	xRoot: TlkJSONobject;
283	xQuotes: TlkJSONobject;	283	xQuotes: TlkJSONobject;
284	resourcestring	284	resourcestring
285	S_JSON_ENTRY_MISSING = 'JSON entry "%s" is missing!';	285	S_JSON_ENTRY_MISSING = 'JSON entry "%s" is missing!';
286	S_WRONG_QUOTE_LEN = 'Length of quotes-entry is unexpected!';	286	S_WRONG_QUOTE_LEN = 'Length of quotes-entry is unexpected!';
287	begin	287	begin
288	result := 0;	288	result := 0;
289		289
290	sJSON := GetJsonRaw(HistoricDate);	290	sJSON := GetJsonRaw(HistoricDate);
291		291
292	xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;	292	xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;
293	try	293	try
294	xSource := xRoot.Field['source'] as TlkJSONstring;	294	xSource := xRoot.Field['source'] as TlkJSONstring;
295	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']);
296		296
297	xQuotes := xRoot.Field['quotes'] as TlkJSONobject;	297	xQuotes := xRoot.Field['quotes'] as TlkJSONobject;
298	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']);
299		299
300	for i := 0 to xQuotes.Count - 1 do	300	for i := 0 to xQuotes.Count - 1 do
301	begin	301	begin
302	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);
303		303
304	if Copy(xQuotes.NameOf[i], 1, 3) = xSource.Value then	304	if Copy(xQuotes.NameOf[i], 1, 3) = xSource.Value then
305	begin	305	begin
306	Inc(result);	306	Inc(result);
307	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));
308	end;	308	end;
309	end;	309	end;
310	finally	310	finally
311	xRoot.Free;	311	xRoot.Free;
312	end;	312	end;
313	end;	313	end;
314		314
315	function TVtsCurConv.GetJsonRaw(HistoricDate: TDate=0): string;	315	function TVtsCurConv.GetJsonRaw(HistoricDate: TDate=0): string;
316		316
317	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);
318	resourcestring	318	resourcestring
319	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?';
320	S_NO_CACHE_EXISTING = 'Cannot get the data online, and no cache exists. Please check your internet connection and API key.';	320	S_NO_CACHE_EXISTING = 'Cannot get the data online, and no cache exists. Please check your internet connection and API key.';
321	begin	321	begin
322	if FallBackToCache then	322	if FallBackToCache then
323	begin	323	begin
324	if not InteractiveAPIKeyInput then	324	if not InteractiveAPIKeyInput then
325	begin	325	begin
326	if not FileExists(cacheFileName) then	326	if not FileExists(cacheFileName) then
327	begin	327	begin
328	raise Exception.Create(S_NO_CACHE_EXISTING);	328	raise Exception.Create(S_NO_CACHE_EXISTING);
329	end;	329	end;
330	json := FileGetContents(cacheFileName);	330	json := FileGetContents(cacheFileName);
331	doRetry := false;	331	doRetry := false;
332	end	332	end
333	else	333	else
334	begin	334	begin
335	if MessageDlg(Trim(msg + ' ' + S_ENTER_NEW_KEY), mtError, mbYesNoCancel, 0) = ID_YES then	335	if MessageDlg(Trim(msg + ' ' + S_ENTER_NEW_KEY), mtError, mbYesNoCancel, 0) = ID_YES then
336	begin	336	begin
337	QueryAPIKey;	337	QueryAPIKey;
338	doRetry := true;	338	doRetry := true;
339	end	339	end
340	else	340	else
341	begin	341	begin
342	if not FileExists(cacheFileName) then	342	if not FileExists(cacheFileName) then
343	begin	343	begin
344	raise Exception.Create(S_NO_CACHE_EXISTING);	344	raise Exception.Create(S_NO_CACHE_EXISTING);
345	end;	345	end;
346	json := FileGetContents(cacheFileName);	346	json := FileGetContents(cacheFileName);
347	doRetry := false;	347	doRetry := false;
348	end;	348	end;
349	end;	349	end;
350	end	350	end
351	else // if not FallBackToCache then	351	else // if not FallBackToCache then
352	begin	352	begin
353	if not InteractiveAPIKeyInput then	353	if not InteractiveAPIKeyInput then
354	begin	354	begin
355	raise EVtsCurConvException.Create(msg);	355	raise EVtsCurConvException.Create(msg);
356	end	356	end
357	else	357	else
358	begin	358	begin
359	QueryAPIKey(msg);	359	QueryAPIKey(msg);
360	doRetry := true;	360	doRetry := true;
361	end;	361	end;
362	end;	362	end;
363	end;	363	end;
364		364
365	function protocol: string;	365	function protocol: string;
366	begin	366	begin
367	if Secure then result := 'https' else result := 'http';	367	if Secure then result := 'https' else result := 'http';
368	end;	368	end;
369		369
370	function url: string;	370	function url: string;
371	var	371	var
372	sDate: string;	372	sDate: string;
373	begin	373	begin
374	if HistoricDate = 0 then	374	if HistoricDate = 0 then
375	begin	375	begin
376	sDate := '';	376	sDate := '';
377	result := protocol + '://www.apilayer.net/api/live?access_key=' + ReadAPIKey;	377	result := protocol + '://www.apilayer.net/api/live?access_key=' + ReadAPIKey;
378	end	378	end
379	else	379	else
380	begin	380	begin
381	DateTimeToString(sDate, 'YYYY-MM-DD', HistoricDate);	381	DateTimeToString(sDate, 'YYYY-MM-DD', HistoricDate);
382	result := protocol + '://www.apilayer.net/api/historical?date=' + sDate + '&access_key=' + ReadAPIKey;	382	result := protocol + '://www.apilayer.net/api/historical?date=' + sDate + '&access_key=' + ReadAPIKey;
383	end;	383	end;
384	end;	384	end;
385		385
386	function cacheFileName: string;	386	function cacheFileName: string;
387	resourcestring	387	resourcestring
388	S_CANNOT_CREATE_DIR = 'Cannot create directory %s';	388	S_CANNOT_CREATE_DIR = 'Cannot create directory %s';
389	var	389	var
390	sDate: string;	390	sDate: string;
391	cacheDirName: string;	391	cacheDirName: string;
392	begin	392	begin
393	// cacheDirName := IncludeTrailingPathDelimiter(GetSpecialPath(CSIDL_PROGRAM_FILES_COMMON)) + 'ViaThinkSoft\CurrencyConverter\';	393	// cacheDirName := IncludeTrailingPathDelimiter(GetSpecialPath(CSIDL_PROGRAM_FILES_COMMON)) + 'ViaThinkSoft\CurrencyConverter\';
394	cacheDirName := IncludeTrailingPathDelimiter(GetTempDir) + 'ViaThinkSoft\CurrencyConverter\';	394	cacheDirName := IncludeTrailingPathDelimiter(GetTempDir) + 'ViaThinkSoft\CurrencyConverter\';
395	if not ForceDirectories(cacheDirName) then	395	if not ForceDirectories(cacheDirName) then
396	begin	396	begin
397	raise EVtsCurConvException.CreateFmt(S_CANNOT_CREATE_DIR, [cacheDirName]);	397	raise EVtsCurConvException.CreateFmt(S_CANNOT_CREATE_DIR, [cacheDirName]);
398	end;	398	end;
399		399
400	if HistoricDate = 0 then	400	if HistoricDate = 0 then
401	begin	401	begin
402	sDate := '';	402	sDate := '';
403	result := IncludeTrailingPathDelimiter(cacheDirName) + 'live.json';	403	result := IncludeTrailingPathDelimiter(cacheDirName) + 'live.json';
404	end	404	end
405	else	405	else
406	begin	406	begin
407	DateTimeToString(sDate, 'YYYY-MM-DD', HistoricDate);	407	DateTimeToString(sDate, 'YYYY-MM-DD', HistoricDate);
408	result := IncludeTrailingPathDelimiter(cacheDirName) + 'historical-' + sDate + '.json';	408	result := IncludeTrailingPathDelimiter(cacheDirName) + 'historical-' + sDate + '.json';
409	end;	409	end;
410	end;	410	end;
411		411
412	var	412	var
413	sJSON, msg: string;	413	sJSON, msg: string;
414	xRoot: TlkJSONobject;	414	xRoot: TlkJSONobject;
415	xSuccess: TlkJSONboolean;	415	xSuccess: TlkJSONboolean;
416	keyInvalid, doRetry: boolean;	416	keyInvalid, doRetry: boolean;
417	needDownload: boolean;	417	needDownload: boolean;
418	mTime: TDateTime;	418	mTime: TDateTime;
419	resourcestring	419	resourcestring
420	S_INVALID_MAXAGE = 'Invalid maxage';	420	S_INVALID_MAXAGE = 'Invalid maxage';
421	S_NO_API_KEY_PROVIDED = 'No API key provided.';	421	S_NO_API_KEY_PROVIDED = 'No API key provided.';
422	S_DOWNLOAD_QUERY = 'Download %s to %s ?';	422	S_DOWNLOAD_QUERY = 'Download %s to %s ?';
423	S_JSON_FILE_INVALID = 'JSON file invalid';	423	S_JSON_FILE_INVALID = 'JSON file invalid';
424	S_UNKNOWN_SUCCESS = 'Cannot determinate status of the query.';	424	S_UNKNOWN_SUCCESS = 'Cannot determinate status of the query.';
425	S_JSON_UNKNOWN_ERROR = 'Unknown error while loading JSON.';	425	S_JSON_UNKNOWN_ERROR = 'Unknown error while loading JSON.';
426	S_API_KEY_INVALID = 'API key invalid.';	426	S_API_KEY_INVALID = 'API key invalid.';
427	begin	427	begin
428	{$REGION 'Determinate if we need to download or not'}	428	{$REGION 'Determinate if we need to download or not'}
429	if HistoricDate = 0 then	429	if HistoricDate = 0 then
430	begin	430	begin
431	needDownload := true;	431	needDownload := true;
432	if MaxAgeSeconds < -1 then	432	if MaxAgeSeconds < -1 then
433	begin	433	begin
434	raise EVtsCurConvException.Create(S_INVALID_MAXAGE);	434	raise EVtsCurConvException.Create(S_INVALID_MAXAGE);
435	end	435	end
436	else if MaxAgeSeconds = -1 then	436	else if MaxAgeSeconds = -1 then
437	begin	437	begin
438	// Only download once	438	// Only download once
439	needDownload := not FileExists(cacheFileName);	439	needDownload := not FileExists(cacheFileName);
440	end	440	end
441	else if MaxAgeSeconds = 0 then	441	else if MaxAgeSeconds = 0 then
442	begin	442	begin
443	// Always download	443	// Always download
444	needDownload := true;	444	needDownload := true;
445	end	445	end
446	else if MaxAgeSeconds > 0 then	446	else if MaxAgeSeconds > 0 then
447	begin	447	begin
448	// Download if older than <MaxAge> seconds	448	// Download if older than <MaxAge> seconds
449	FileAge(cacheFileName, mTime);	449	FileAge(cacheFileName, mTime);
450	needDownload := not FileExists(cacheFileName) or (SecondsBetween(Now, mTime) > MaxAgeSeconds);	450	needDownload := not FileExists(cacheFileName) or (SecondsBetween(Now, mTime) > MaxAgeSeconds);
451	end;	451	end;
452	end	452	end
453	else	453	else
454	begin	454	begin
455	needDownload := not FileExists(cacheFileName)	455	needDownload := not FileExists(cacheFileName)
456	end;	456	end;
457	{$ENDREGION}	457	{$ENDREGION}
458		458
459	if not needDownload and FileExists(cacheFileName) then	459	if not needDownload and FileExists(cacheFileName) then
460	begin	460	begin
461	sJSON := FileGetContents(cacheFileName);	461	sJSON := FileGetContents(cacheFileName);
462	end	462	end
463	else	463	else
464	begin	464	begin
465	doRetry := false;	465	doRetry := false;
466		466
467	{$REGION 'Is an API key available?'}	467	{$REGION 'Is an API key available?'}
468	if ReadAPIKey = '' then	468	if ReadAPIKey = '' then
469	begin	469	begin
470	_HandleKeyInvalidOrMissing(cacheFileName, S_NO_API_KEY_PROVIDED, doRetry, sJSON);	470	_HandleKeyInvalidOrMissing(cacheFileName, S_NO_API_KEY_PROVIDED, doRetry, sJSON);
471	if not doRetry then	471	if not doRetry then
472	begin	472	begin
473	result := sJSON;	473	result := sJSON;
474	Exit;	474	Exit;
475	end;	475	end;
476	end;	476	end;
477	{$ENDREGION}	477	{$ENDREGION}
478		478
479	{$REGION 'Download and check if everything is OK'}	479	{$REGION 'Download and check if everything is OK'}
480	repeat	480	repeat
481	{$REGION 'Confirm web access?'}	481	{$REGION 'Confirm web access?'}
482	if ConfirmWebAccess and (MessageDlg(Format(S_DOWNLOAD_QUERY, [url, cacheFileName]), mtConfirmation, mbYesNoCancel, 0) <> ID_YES) then	482	if ConfirmWebAccess and (MessageDlg(Format(S_DOWNLOAD_QUERY, [url, cacheFileName]), mtConfirmation, mbYesNoCancel, 0) <> ID_YES) then
483	begin	483	begin
484	if FallBackToCache and FileExists(cacheFileName) then	484	if FallBackToCache and FileExists(cacheFileName) then
485	begin	485	begin
486	result := FileGetContents(cacheFileName);	486	result := FileGetContents(cacheFileName);
487	Exit;	487	Exit;
488	end	488	end
489	else Abort;	489	else Abort;
490	end;	490	end;
491	{$ENDREGION}	491	{$ENDREGION}
492		492
493	doRetry := false;	493	doRetry := false;
494		494
495	sJSON := GetPage(url);	495	sJSON := GetPage(url);
496		496
497	xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;	497	xRoot := TlkJSON.ParseText(sJSON) as TlkJSONobject;
498	if not assigned(xRoot) then raise EVtsCurConvException.Create(S_JSON_FILE_INVALID);	498	if not assigned(xRoot) then raise EVtsCurConvException.Create(S_JSON_FILE_INVALID);
499	try	499	try
500	xSuccess := xRoot.Field['success'] as TlkJSONboolean;	500	xSuccess := xRoot.Field['success'] as TlkJSONboolean;

Subversion Repositories currency_converter

currency_converter/trunk/RTL/VtsCurConv.pas – Rev 19 → 22