Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Samples/MegaDemo/MegaDemoService_Impl.pas

unit MegaDemoService_Impl;

{----------------------------------------------------------------------------}
{ This unit was automatically generated by the RemObjects SDK after reading  }
{ the RODL file associated with this project .                               }
{                                                                            }
{ This is where you are supposed to code the implementation of your objects. }
{----------------------------------------------------------------------------}

interface

uses
  {vcl:} Classes, SysUtils,
  {RemObjects:} uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions,
  {Required:} uRORemoteDataModule,
  {Generated:} MegaDemoLibrary_Intf;

type
  { TMegaDemoService }
  TMegaDemoService = class(TRORemoteDataModule, IMegaDemoService)
    procedure RORemoteDataModuleDeactivate(const aClientID: TGUID;
      aSession: TROSession);
  private
  protected
    { IMegaDemoService methods }
    function Sum(const A: Integer; const B: Integer): Integer;
    function GetServerTime: DateTime;
    procedure EchoPerson(const aPerson: TPerson; out anotherPerson: TPerson);
    function TestIntegerArray(const anArray: TIntegerArray): TIntegerArray;
    function TestStringArray(const anArray: TStringArray): TStringArray;
    function TestPersonArray(const anArray: TPersonArray): TPersonArray;
    procedure EchoBinary(const BinIN: binary; out BinOUT: Binary);
    procedure SomeTypes(var aString: string; var aWidestring: Widestring; var anInteger: Integer; var
      aCurrency: Currency; var aDatetime: DateTime);
    function CustomObjectAsString: string;
    function CustomObjectAsStream: Binary;
    procedure RaiseError;
    procedure RaiseTestException;
  end;

implementation

{$R *.dfm}
uses
  {Generated:} MegaDemoLibrary_Invk, MegaDemoServerMain,
  MegaDemoCustomClass, uROXMLSerializer, uROStreamSerializer;

procedure Create_MegaDemoService(out anInstance: IUnknown);
begin
  anInstance := TMegaDemoService.Create(nil);
end;

{ MegaService }

function TMegaDemoService.Sum(const A: Integer; const B: Integer): Integer;
begin
  result := A + B;
end;

function TMegaDemoService.GetServerTime: DateTime;
begin
  result := Now;
end;

procedure TMegaDemoService.EchoPerson(const aPerson: TPerson; out anotherPerson: TPerson);
begin
  anotherPerson := TPerson.Create;

  anotherPerson.FirstName := aPerson.FirstName;
  anotherPerson.LastName := aPerson.LastName;
  anotherPerson.Age := aPerson.Age;
  anotherPerson.Sex := aPerson.Sex;
end;

function TMegaDemoService.TestIntegerArray(const anArray: TIntegerArray): TIntegerArray;
var
  i: integer;
begin
  result := TIntegerArray.Create;
  for i := 0 to anArray.Count - 1 do
    result.Add(anArray[i]);
end;

function TMegaDemoService.TestStringArray(const anArray: TStringArray): TStringArray;
var
  i: integer;
begin
  result := TStringArray.Create;
  for i := 0 to anArray.Count - 1 do
    result.Add(anArray[i]);
end;

function TMegaDemoService.TestPersonArray(const anArray: TPersonArray): TPersonArray;
var
  i: integer;
begin
  result := TPersonArray.Create;
  for i := 0 to anArray.Count - 1 do begin
    with result.Add do begin
      FirstName := anArray[i].FirstName;
      LastName := anArray[i].LastName;
      Age := anArray[i].Age;
      Sex := anArray[i].Sex;
    end;
  end;
end;

procedure TMegaDemoService.EchoBinary(const BinIN: binary; out BinOUT: Binary);
begin
  BinOut := Binary.Create;
  BinOUT.CopyFrom(BinIN, BinIN.Size);
end;

procedure TMegaDemoService.SomeTypes(var aString: string; var aWidestring: Widestring; var anInteger:
  Integer; var aCurrency: Currency; var aDatetime: DateTime);
begin
  aString := 'received aString: "' + aString + '"';
  aWidestring := 'received aWideString "' + aWideString + '"';
  anInteger := anInteger * 2;
  aCurrency := aCurrency * 2;
  aDatetime := Now;
end;

function TMegaDemoService.CustomObjectAsString: string;
var
  cls: TCustomClass;
begin
  result := '';

  cls := NewCustomClass;
  try
    result := ObjectToXML(cls);
  finally
    cls.Free;
  end;
end;

function TMegaDemoService.CustomObjectAsStream: Binary;
var
  cls: TCustomClass;
begin
  result := Binary.Create;

  cls := NewCustomClass;
  try
    ObjectToStream(cls, result);
  finally
    cls.Free;
  end;
end;

procedure TMegaDemoService.RaiseError;
begin
  // Generic and unregistered exceptions
  raise EDivByZero.Create('A fake div by zero!');
end;

procedure TMegaDemoService.RaiseTestException;
begin
  raise ETestException.Create('This is the exception message', 666, 'Some extra info here');
end;

procedure TMegaDemoService.RORemoteDataModuleDeactivate(const aClientID: TGUID;
  aSession: TROSession);
begin
  if Assigned(MegaDemoServerMainForm) then MegaDemoServerMainForm.Log('Complete!');
end;

initialization
  TROClassFactory.Create('MegaDemoService', Create_MegaDemoService, TMegaDemoService_Invoker);

finalization

end.