Project Structure

• ConvertService.dpr
• ConvertWebMod.pas
• ConvertIntf.pas
• ConvertImpl.pas
• EuroConvConst.pas
• ConvertWebMod.dfm

program ConvertService;

{$APPTYPE CONSOLE}

uses
  WebBroker,
  CGIApp,
  ConvertWebMod in 'ConvertWebMod.pas' {WebModule1: TWebModule},
  ConvertIntf in 'ConvertIntf.pas',
  ConvertImpl in 'ConvertImpl.pas',
  EuroConvConst in 'EuroConvConst.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TWebModule1, WebModule1);
  Application.Run;
end.

unit ConvertWebMod;

interface

uses
  SysUtils, Classes, HTTPApp, WSDLPub, SOAPPasInv, SOAPHTTPPasInv,
  SoapHTTPDisp, WebBrokerSOAP;

type
  TWebModule1 = class(TWebModule)
    HTTPSoapDispatcher1: THTTPSoapDispatcher;
    HTTPSoapPascalInvoker1: THTTPSoapPascalInvoker;
    WSDLHTMLPublish1: TWSDLHTMLPublish;
    procedure WebModule1WebActionItem1Action(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModule1: TWebModule1;

implementation

{$R *.DFM}

uses
  InvokeRegistry, ConvertIntf;

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content :=
    '<h3>GetMethExternalName - ToEuro</h3><p>' +
    InvRegistry.GetMethExternalName(TypeInfo(IConvert), 'ToEuro') +

    '<h3>GetInterfaceExternalName - IConvert</h3><p>' +
    InvRegistry.GetInterfaceExternalName(TypeInfo(IConvert)) +

    '<h3>GetNamespaceByGUID - IConvert</h3><p>' +
    InvRegistry.GetNamespaceByGUID (IConvert);
end;

end.

unit ConvertIntf;

interface

type
  IConvert = interface(IInvokable)
  ['{FF1EAA45-0B94-4630-9A18-E768A91A78E2}']
    function ConvertCurrency (Source, Dest: string; Amount: Double): Double; stdcall;
    function ToEuro (Source: string; Amount: Double): Double; stdcall;
    function FromEuro (Dest: string; Amount: Double): Double; stdcall;
    function TypesList: string; stdcall;
end;

implementation

uses
  InvokeRegistry;

initialization
  InvRegistry.RegisterInterface(TypeInfo(IConvert));
end.

unit ConvertImpl;

interface

uses
  Classes, SysUtils, InvokeRegistry, ConvertIntf;

type
  TConvert = class (TInvokableClass, IConvert)
  protected
    function ConvertCurrency (Source, Dest: string; Amount: Double): Double; stdcall;
    function ToEuro (Source: string; Amount: Double): Double; stdcall;
    function FromEuro (Dest: string; Amount: Double): Double; stdcall;
    function TypesList: string; stdcall;
      end;

implementation

uses
  ConvUtils, EuroConvConst;

{ TConvert }

function TConvert.ConvertCurrency(Source, Dest: string;
  Amount: Double): Double;
var
  BaseType, DestType: TConvType;
begin
  if DescriptionToConvType (cbEuroCurrency, Source, BaseType) and
      DescriptionToConvType (cbEuroCurrency, Dest, DestType) then
    Result := EuroConvert (Amount, BaseType, DestType, 4)
  else
    raise Exception.Create ('Undefined currency types');
end;

function TConvert.FromEuro(Dest: string; Amount: Double): Double;
var
  DestType: TConvType;
begin
  Result := 0;
  if DescriptionToConvType (cbEuroCurrency, Dest, DestType) then
    Result := EuroConvert (Amount, cuEUR, DestType, 4);
end;

function TConvert.ToEuro(Source: string; Amount: Double): Double;
var
  BaseType: TConvType;
begin
  Result := 0;
  if DescriptionToConvType (cbEuroCurrency, Source, BaseType) then
    Result := EuroConvert (Amount, BaseType, cuEUR, 4);
end;

function TConvert.TypesList: string;
var
  i: Integer;
  ATypes: TConvTypeArray;
begin
  Result := '';
  GetConvTypes(cbEuroCurrency, ATypes);
  for i := Low(aTypes) to High(aTypes) do
    Result := Result + ConvTypeToDescription (aTypes[i]) + ';';
end;

initialization
  InvRegistry.RegisterInvokableClass (TConvert);
end.

unit EuroConvConst;

interface

uses
  ConvUtils;

var
  // Euro Currency Conversion Units
  // basic unit of measurement is Euro
  cbEuroCurrency: TConvFamily;

  cuEUR: TConvType;
  cuDEM: TConvType; // Germany
  cuESP: TConvType; // Spain
  cuFRF: TConvType; // France
  cuIEP: TConvType; // Ireland
  cuITL: TConvType; // Italy
  cuBEF: TConvType; // Belgium
  cuNLG: TConvType; // Holland
  cuATS: TConvType; // Austria
  cuPTE: TConvType; // Portugal
  cuFIM: TConvType; // Finland
  cuGRD: TConvType; // Greece
  cuLUF: TConvType; // Luxembourg

type
  TEuroDecimals = 3..6;

function EuroConvert (const AValue: Double; const AFrom, ATo: TConvType;
  const Decimals: TEuroDecimals = 3): Double;

implementation

uses
  Math;

const
  DEMPerEuros = 1.95583;
  ESPPerEuros = 166.386;
  FRFPerEuros = 6.55957;
  IEPPerEuros =  0.787564;
  ITLPerEuros =  1936.27;
  BEFPerEuros =  40.3399;
  NLGPerEuros =  2.20371;
  ATSPerEuros =  13.7603;
  PTEPerEuros =  200.482;
  FIMPerEuros =  5.94573;
  GRDPerEuros = 340.750;
  LUFPerEuros = 40.3399;

function EuroConvert (const AValue: Double; const AFrom, ATo: TConvType;
  const Decimals: TEuroDecimals = 3): Double;
begin
  // check special case: no conversion
  if AFrom = ATo then
    Result := AValue
  else
  begin
    // convert to Euro, than round
    Result := ConvertFrom (AFrom, AValue);
    Result := RoundTo (Result, -Decimals);
    // convert to currency than round again
    Result := ConvertTo (Result, ATo);
    Result := RoundTo (Result, -Decimals);
  end;
end;


initialization
  // Euro Currency's family type
  cbEuroCurrency := RegisterConversionFamily('EuroCurrency');

  cuEUR := RegisterConversionType(cbEuroCurrency, 'EUR', 1);
  cuDEM := RegisterConversionType(cbEuroCurrency, 'DEM', 1 / DEMPerEuros);
  cuESP := RegisterConversionType(cbEuroCurrency, 'ESP', 1 / ESPPerEuros);
  cuFRF := RegisterConversionType(cbEuroCurrency, 'FRF', 1 / FRFPerEuros);
  cuIEP := RegisterConversionType(cbEuroCurrency, 'IEP', 1 / IEPPerEuros);
  cuITL := RegisterConversionType(cbEuroCurrency, 'ITL', 1 / ITLPerEuros);
  cuBEF := RegisterConversionType(cbEuroCurrency, 'BEF', 1 / BEFPerEuros);
  cuNLG := RegisterConversionType(cbEuroCurrency, 'NLG', 1 / NLGPerEuros);
  cuATS := RegisterConversionType(cbEuroCurrency, 'ATS', 1 / ATSPerEuros);
  cuPTE := RegisterConversionType(cbEuroCurrency, 'PTE', 1 / PTEPerEuros);
  cuFIM := RegisterConversionType(cbEuroCurrency, 'FIM', 1 / FIMPerEuros);
  cuGRD := RegisterConversionType(cbEuroCurrency, 'GRD', 1 / GRDPerEuros);
  cuLUF := RegisterConversionType(cbEuroCurrency, 'LUF', 1 / LUFPerEuros);
end.

object WebModule1: TWebModule1
  OldCreateOrder = False
  Actions = <
    item
      Name = 'WebActionItem1'
      PathInfo = '/test'
      OnAction = WebModule1WebActionItem1Action
    end>
  Left = 316
  Top = 116
  Height = 170
  Width = 499
  object HTTPSoapDispatcher1: THTTPSoapDispatcher
    Dispatcher = HTTPSoapPascalInvoker1
    WebDispatch.MethodType = mtAny
    WebDispatch.PathInfo = 'soap*'
    Left = 64
    Top = 48
  end
  object HTTPSoapPascalInvoker1: THTTPSoapPascalInvoker
    Converter.Options = [soSendMultiRefObj, soTryAllSchema]
    Left = 208
    Top = 48
  end
  object WSDLHTMLPublish1: TWSDLHTMLPublish
    WebDispatch.MethodType = mtAny
    WebDispatch.PathInfo = 'wsdl*'
    AdminEnabled = False
    Left = 352
    Top = 48
  end
end