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



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

    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;

 
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

  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

          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;
 
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

  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

    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);

      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;

      {$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;

        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);

              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

Rev 2	Rev 13
Line 70...	Line 70...
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
Line 81...	Line 83...
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;
Line 112...	Line 114...
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
Line 192...	Line 196...
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));
Line 203...	Line 212...
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
Line 235...	Line 244...
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));
Line 291...	Line 307...
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
Line 337...	Line 355...
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
Line 368...	Line 395...
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);
Line 404...	Line 431...
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;
Line 416...	Line 443...
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;
Line 432...	Line 459...
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);
Line 456...	Line 483...
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

Subversion Repositories currency_converter

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