library CurConv;
uses
SysUtils,
Classes,
Windows,
Dialogs,
Controls,
uLkJSON in '..\RTL\uLkJSON.pas',
VtsCurConv in '..\RTL\VtsCurConv.pas';
{$R *.res}
type
TVtsCurConvFlags = type DWORD;
const
CONVERT_DONT_SHOW_ERRORS: TVtsCurConvFlags = 1;
CONVERT_FALLBACK_TO_CACHE: TVtsCurConvFlags = 2;
CONVERT_USE_SSL: TVtsCurConvFlags = 4;
CONVERT_CONFIRM_WEB_ACCESS: TVtsCurConvFlags = 8;
CONVERT_NO_INTERACTIVE_API_KEY_INPUT: TVtsCurConvFlags = 16;
const
S_VTSCONV_OK: HRESULT = $20000000; // Success, Customer defined, Facility 0, Code 0
S_VTSCONV_NOTHING: HRESULT = $20000001; // Success, Customer defined, Facility 0, Code 1
E_VTSCONV_GENERIC_FAILURE: HRESULT = $A0000000; // Failure, Customer defined, Facility 0, Code 0
E_VTSCONV_BAD_ARGS: HRESULT = $A0000001; // Failure, Customer defined, Facility 0, Code 1
E_VTSCONV_STOREDKEY_INVALID: HRESULT = $A0000002; // Failure, Customer defined, Facility 0, Code 2
E_VTSCONV_NO_STOREDKEY: HRESULT = $A0000003; // Failure, Customer defined, Facility 0, Code 3
function DeleteAPIKey(UserMode: BOOL; DontShowErrors: BOOL): HRESULT; stdcall;
begin
try
if TVtsCurConv.DeleteAPIKey(UserMode) then
result := S_VTSCONV_OK
else
result := S_VTSCONV_NOTHING;
except
on E: Exception do
begin
if DontShowErrors then MessageDlg(e.Message, mtError, [mbOk], 0);
result := E_VTSCONV_GENERIC_FAILURE;
end;
end;
end;
function WriteAPIKeyW(key: LPCWSTR; UserMode: BOOL; DontShowErrors: BOOL): HRESULT; stdcall;
begin
try
if Length(key) <> 32 then
begin
result := E_VTSCONV_BAD_ARGS;
Exit;
end;
TVtsCurConv.WriteAPIKey(TVtsCurApiKey(key), UserMode);
result := S_VTSCONV_OK;
except
on E: Exception do
begin
if DontShowErrors then MessageDlg(e.Message, mtError, [mbOk], 0);
result := E_VTSCONV_GENERIC_FAILURE;
end;
end;
end;
function WriteAPIKeyA(key: LPCSTR; UserMode: BOOL; DontShowErrors: BOOL): HRESULT; stdcall;
begin
try
if Length(key) <> 32 then
begin
result := E_VTSCONV_BAD_ARGS;
Exit;
end;
TVtsCurConv.WriteAPIKey(TVtsCurApiKey(key), UserMode);
result := S_VTSCONV_OK;
except
on E: Exception do
begin
if DontShowErrors then MessageDlg(e.Message, mtError, [mbOk], 0);
result := E_VTSCONV_GENERIC_FAILURE;
end;
end;
end;
function ReadAPIKeyW(key: LPWSTR; DontShowErrors: BOOL): HRESULT; stdcall;
var
s: WideString;
begin
try
s := WideString(TVtsCurConv.ReadAPIKey);
if s = '' then
begin
result := E_VTSCONV_NO_STOREDKEY;
Exit;
end;
if Length(s) <> 32 then
begin
result := E_VTSCONV_STOREDKEY_INVALID;
Exit;
end;
ZeroMemory(key, 33*SizeOf(WideChar));
CopyMemory(key, @s[1], 32*SizeOf(WideChar));
Result := S_VTSCONV_OK;
except
on E: Exception do
begin
if DontShowErrors then MessageDlg(e.Message, mtError, [mbOk], 0);
result := E_VTSCONV_GENERIC_FAILURE;
end;
end;
end;
function ReadAPIKeyA(key: LPSTR; DontShowErrors: BOOL): HRESULT; stdcall;
var
s: AnsiString;
begin
try
s := AnsiString(TVtsCurConv.ReadAPIKey);
if s = '' then
begin
result := E_VTSCONV_NO_STOREDKEY;
Exit;
end;
if Length(s) <> 32 then
begin
result := E_VTSCONV_STOREDKEY_INVALID;
Exit;
end;
ZeroMemory(key, 33*SizeOf(AnsiChar));
CopyMemory(key, @s[1], 32*SizeOf(AnsiChar));
result := S_VTSCONV_OK;
except
on E: Exception do
begin
if DontShowErrors then MessageDlg(e.Message, mtError, [mbOk], 0);
result := E_VTSCONV_GENERIC_FAILURE;
end;
end;
end;
function ConvertW(Value: Double; CurFrom, CurTo: LPCWSTR; MaxAge: integer;
Flags: TVtsCurConvFlags; HistoricDate: TDate): Double; stdcall;
var
x: TVtsCurConv;
begin
try
x := TVtsCurConv.Create;
try
x.Secure := Flags and CONVERT_USE_SSL <> 0;
x.MaxAgeSeconds := MaxAge;
x.ConfirmWebAccess := Flags and CONVERT_CONFIRM_WEB_ACCESS <> 0;
x.FallBackToCache := Flags and CONVERT_FALLBACK_TO_CACHE <> 0;
x.InteractiveAPIKeyInput := Flags and CONVERT_NO_INTERACTIVE_API_KEY_INPUT = 0;
result := x.Convert(value, TVtsCur(CurFrom), TVtsCur(CurTo), HistoricDate);
finally
x.Free;
end;
except
on E: Exception do
begin
if Flags and CONVERT_DONT_SHOW_ERRORS = 0 then MessageDlg(e.Message, mtError, [mbOk], 0);
result := -1;
end;
end;
end;
function ConvertA(Value: Double; CurFrom, CurTo: LPCSTR; MaxAge: integer;
Flags: TVtsCurConvFlags; HistoricDate: TDate): Double; stdcall;
var
x: TVtsCurConv;
begin
try
x := TVtsCurConv.Create;
try
x.Secure := Flags and CONVERT_USE_SSL <> 0;
x.MaxAgeSeconds := MaxAge;
x.ConfirmWebAccess := Flags and CONVERT_CONFIRM_WEB_ACCESS <> 0;
x.FallBackToCache := Flags and CONVERT_FALLBACK_TO_CACHE <> 0;
x.InteractiveAPIKeyInput := Flags and CONVERT_NO_INTERACTIVE_API_KEY_INPUT = 0;
result := x.Convert(value, TVtsCur(CurFrom), TVtsCur(CurTo), HistoricDate);
finally
x.Free;
end;
except
on E: Exception do
begin
if Flags and CONVERT_DONT_SHOW_ERRORS = 0 then MessageDlg(e.Message, mtError, [mbOk], 0);
result := -1;
end;
end;
end;
function AcceptedCurrenciesW(WriteTo: LPWSTR; MaxAge: integer; Flags: TVtsCurConvFlags;
HistoricDate: TDate): Integer; stdcall;
var
x: TVtsCurConv;
sl: TStringList;
s: WideString;
i: integer;
begin
try
x := TVtsCurConv.Create;
if Assigned(WriteTo) then sl := TStringList.Create else sl := nil;
try
x.Secure := Flags and CONVERT_USE_SSL <> 0;
x.MaxAgeSeconds := MaxAge;
x.ConfirmWebAccess := Flags and CONVERT_CONFIRM_WEB_ACCESS <> 0;
x.FallBackToCache := Flags and CONVERT_FALLBACK_TO_CACHE <> 0;
x.InteractiveAPIKeyInput := Flags and CONVERT_NO_INTERACTIVE_API_KEY_INPUT = 0;
result := x.GetAcceptedCurrencies(sl, HistoricDate);
if Assigned(WriteTo) then
begin
s := '';
for i := 0 to sl.Count - 1 do s := s + WideString(Trim(sl.Strings[i]));
ZeroMemory(WriteTo, (3*result+1)*SizeOf(WideChar));
CopyMemory(WriteTo, @s[1], 3*result*SizeOf(WideChar));
end;
finally
x.Free;
if Assigned(WriteTo) then sl.Free;
end;
except
on E: Exception do
begin
if Flags and CONVERT_DONT_SHOW_ERRORS = 0 then MessageDlg(e.Message, mtError, [mbOk], 0);
result := -1;
end;
end;
end;
function AcceptedCurrenciesA(WriteTo: LPSTR; MaxAge: integer; Flags: TVtsCurConvFlags;
HistoricDate: TDate): Integer; stdcall;
var
x: TVtsCurConv;
sl: TStringList;
s: AnsiString;
i: integer;
begin
try
x := TVtsCurConv.Create;
if Assigned(WriteTo) then sl := TStringList.Create else sl := nil;
try
x.Secure := Flags and CONVERT_USE_SSL <> 0;
x.MaxAgeSeconds := MaxAge;
x.ConfirmWebAccess := Flags and CONVERT_CONFIRM_WEB_ACCESS <> 0;
x.FallBackToCache := Flags and CONVERT_FALLBACK_TO_CACHE <> 0;
x.InteractiveAPIKeyInput := Flags and CONVERT_NO_INTERACTIVE_API_KEY_INPUT = 0;
result := x.GetAcceptedCurrencies(sl, HistoricDate);
if Assigned(WriteTo) then
begin
s := '';
for i := 0 to sl.Count - 1 do s := s + AnsiString(Trim(sl.Strings[i]));
ZeroMemory(WriteTo, (3*result+1)*SizeOf(AnsiChar));
CopyMemory(WriteTo, @s[1], 3*result*SizeOf(AnsiChar));
end;
finally
x.Free;
if Assigned(WriteTo) then sl.Free;
end;
except
on E: Exception do
begin
if Flags and CONVERT_DONT_SHOW_ERRORS = 0 then MessageDlg(e.Message, mtError, [mbOk], 0);
result := -1;
end;
end;
end;
function DownloadNow(Flags: TVtsCurConvFlags; HistoricDate: TDate): HRESULT; stdcall;
var
x: TVtsCurConv;
begin
try
x := TVtsCurConv.Create;
try
x.Secure := Flags and CONVERT_USE_SSL <> 0;
x.MaxAgeSeconds := 0; // Always Download
x.ConfirmWebAccess := Flags and CONVERT_CONFIRM_WEB_ACCESS <> 0;
x.FallBackToCache := Flags and CONVERT_FALLBACK_TO_CACHE <> 0;
x.InteractiveAPIKeyInput := Flags and CONVERT_NO_INTERACTIVE_API_KEY_INPUT = 0;
x.Convert(1, 'USD', 'USD', HistoricDate);
result := S_VTSCONV_OK
finally
x.Free;
end;
except
on E: Exception do
begin
if Flags and CONVERT_DONT_SHOW_ERRORS = 0 then MessageDlg(e.Message, mtError, [mbOk], 0);
result := E_VTSCONV_GENERIC_FAILURE;
end;
end;
end;
exports
DeleteAPIKey,
WriteAPIKeyW,
WriteAPIKeyA,
ReadAPIKeyW,
ReadAPIKeyA,
ConvertW,
ConvertA,
AcceptedCurrenciesW,
AcceptedCurrenciesA,
DownloadNow;
begin
end.