Componentes.Terceros.RemObj.../internal/5.0.23.613/1/RemObjects SDK for Delphi/Samples/MegaDemo/MegaDemoLibrary_Intf.pas
david f0e35ec439 - Eliminadas las librerías para Delphi 6 (Dcu\D6) en RO y DA.
- Recompilación de RO para poner RemObjects_Core_D10 como paquete de runtime/designtime.

git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@3 b6239004-a887-0f4b-9937-50029ccdca16
2007-09-10 10:40:17 +00:00

824 lines
23 KiB
ObjectPascal

unit MegaDemoLibrary_Intf;
{----------------------------------------------------------------------------}
{ This unit was automatically generated by the RemObjects SDK after reading }
{ the RODL file associated with this project . }
{ }
{ Do not modify this unit manually, or your changes will be lost when this }
{ unit is regenerated the next time you compile the project. }
{----------------------------------------------------------------------------}
interface
uses
{vcl:} Classes, TypInfo,
{RemObjects:} uROClasses, uROClient, uROTypes, uROClientIntf;
const
{ Library ID }
LibraryUID = '{D9821C1A-A084-4120-93F3-BCE6CF2AE0F4}';
{ Service Interface ID's }
IMegaDemoService_IID : TGUID = '{D9821C1A-A084-4120-93F3-BCE6CF2AE0F4}';
{ Event ID's }
type
{ Forward declarations }
IMegaDemoService = interface;
TPersonArray = class;
TIntegerArray = class;
TStringArray = class;
TPerson = class;
ETestException = class;
{ Enumerateds }
TSex = (TSex_sxMale,TSex_sxFemale);
{ TPerson }
TPerson = class(TROComplexType)
private
fFirstName: String;
fLastName: String;
fAge: Integer;
fSex: TSex;
public
procedure Assign(iSource: TPersistent); override;
published
property FirstName:String read fFirstName write fFirstName;
property LastName:String read fLastName write fLastName;
property Age:Integer read fAge write fAge;
property Sex:TSex read fSex write fSex;
end;
{ TPersonCollection }
TPersonCollection = class(TROCollection)
protected
constructor Create(aItemClass: TCollectionItemClass); overload;
function GetItems(Index: integer): TPerson;
procedure SetItems(Index: integer; const Value: TPerson);
public
constructor Create; overload;
function Add: TPerson; reintroduce;
procedure SaveToArray(anArray: TPersonArray);
procedure LoadFromArray(anArray: TPersonArray);
property Items[Index: integer]:TPerson read GetItems write SetItems; default;
end;
{ TPersonArray }
TPersonArray = class(TROArray)
private
fCount: Integer;
fItems : array of TPerson;
protected
procedure Grow; virtual;
function GetItems(Index: integer): TPerson;
procedure SetItems(Index: integer; const Value: TPerson);
function GetCount: integer; override;
public
class function GetItemType: PTypeInfo; override;
class function GetItemClass: TClass; override;
class function GetItemSize: integer; override;
function GetItemRef(Index: integer): pointer; override;
procedure SetItemRef(Index: integer; Ref: pointer); override;
procedure Clear; override;
procedure Delete(Index: integer); override;
procedure Resize(ElementCount: integer); override;
procedure Assign(iSource:TPersistent); override;
function Add: TPerson; overload;
function Add(const Value: TPerson):integer; overload;
property Count : integer read GetCount;
property Items[Index: integer]:TPerson read GetItems write SetItems; default;
end;
{ TIntegerArray }
TIntegerArray = class(TROArray)
private
fCount: Integer;
fItems : array of Integer;
protected
procedure Grow; virtual;
function GetItems(Index: integer): Integer;
procedure SetItems(Index: integer; const Value: Integer);
function GetCount: integer; override;
public
class function GetItemType: PTypeInfo; override;
class function GetItemSize: integer; override;
function GetItemRef(Index: integer): pointer; override;
procedure Clear; override;
procedure Delete(Index: integer); override;
procedure Resize(ElementCount: integer); override;
procedure Assign(iSource:TPersistent); override;
function Add(const Value:Integer): integer;
property Count : integer read GetCount;
property Items[Index: integer]:Integer read GetItems write SetItems; default;
end;
{ TStringArray }
TStringArray = class(TROArray)
private
fCount: Integer;
fItems : array of String;
protected
procedure Grow; virtual;
function GetItems(Index: integer): String;
procedure SetItems(Index: integer; const Value: String);
function GetCount: integer; override;
public
class function GetItemType: PTypeInfo; override;
class function GetItemSize: integer; override;
function GetItemRef(Index: integer): pointer; override;
procedure Clear; override;
procedure Delete(Index: integer); override;
procedure Resize(ElementCount: integer); override;
procedure Assign(iSource:TPersistent); override;
function Add(const Value:String): integer;
property Count : integer read GetCount;
property Items[Index: integer]:String read GetItems write SetItems; default;
end;
{ Exceptions }
ETestException = class(EROException)
private
fErrorCode: Integer;
fAdditionalInfo: String;
public
constructor Create(anExceptionMessage : string; aErrorCode: Integer; aAdditionalInfo: String);
published
property ErrorCode: Integer read fErrorCode write fErrorCode;
property AdditionalInfo: String read fAdditionalInfo write fAdditionalInfo;
end;
{ IMegaDemoService }
IMegaDemoService = interface
['{D9821C1A-A084-4120-93F3-BCE6CF2AE0F4}']
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;
{ CoMegaDemoService }
CoMegaDemoService = class
class function Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): IMegaDemoService;
end;
{ TMegaDemoService_Proxy }
TMegaDemoService_Proxy = class(TROProxy, IMegaDemoService)
protected
function __GetInterfaceName:string; override;
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
uses
{vcl:} SysUtils,
{RemObjects:} uROEventRepository, uRORes;
{ ETestException }
constructor ETestException.Create(anExceptionMessage : string; aErrorCode: Integer;
aAdditionalInfo: String);
begin
inherited Create(anExceptionMessage);
fErrorCode := aErrorCode;
fAdditionalInfo := aAdditionalInfo;
end;
{ TPersonArray }
procedure TPersonArray.Assign(iSource: TPersistent);
var lSource:TPersonArray;
i:integer;
begin
if (iSource is TPersonArray) then begin
lSource := TPersonArray(iSource);
Clear();
Resize(lSource.Count);
for i := 0 to Count-1 do begin
if Assigned(lSource.Items[i]) then begin
Items[i] := lSource.Items[i].Clone() as TPerson;
end;
end;
end
else begin
inherited Assign(iSource);
end;
end;
class function TPersonArray.GetItemType: PTypeInfo;
begin
result := TypeInfo(TPerson);
end;
class function TPersonArray.GetItemClass: TClass;
begin
result := TPerson;
end;
class function TPersonArray.GetItemSize: integer;
begin
result := SizeOf(TPerson);
end;
function TPersonArray.GetItems(Index: integer): TPerson;
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
result := fItems[Index];
end;
function TPersonArray.GetItemRef(Index: integer): pointer;
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
result := fItems[Index];
end;
procedure TPersonArray.SetItemRef(Index: integer; Ref: pointer);
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
if Ref <> fItems[Index] then
fItems[Index] := Ref;
end;
procedure TPersonArray.Clear;
var i: integer;
begin
for i := 0 to (Count-1) do fItems[i].Free();
SetLength(fItems, 0);
FCount := 0;
end;
procedure TPersonArray.Delete(Index: integer);
var i: integer;
begin
if (Index>=Count) then RaiseError(err_InvalidIndex, [Index]);
fItems[Index].Free();
if (Index<Count-1) then
for i := Index to Count-2 do fItems[i] := fItems[i+1];
SetLength(fItems, Count-1);
Dec(FCount);
end;
procedure TPersonArray.SetItems(Index: integer; const Value: TPerson);
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
fItems[Index] := Value;
end;
procedure TPersonArray.Resize(ElementCount: integer);
begin
SetLength(fItems, ElementCount);
FCount := ElementCount;
end;
function TPersonArray.GetCount: integer;
begin
result := FCount;
end;
procedure TPersonArray.Grow;
var
Delta, Capacity: Integer;
begin
Capacity := Length(fItems);
if Capacity > 64 then
Delta := Capacity div 4
else
if Capacity > 8 then
Delta := 16
else
Delta := 4;
SetLength(fItems, Capacity + Delta);
end;
function TPersonArray.Add: TPerson;
begin
result := TPerson.Create;
Add(Result);
end;
function TPersonArray.Add(const Value:TPerson): integer;
begin
Result := Count;
if Length(fItems) = Result then
Grow;
fItems[result] := Value;
Inc(fCount);
end;
{ TIntegerArray }
procedure TIntegerArray.Assign(iSource: TPersistent);
var lSource:TIntegerArray;
i:integer;
begin
if (iSource is TIntegerArray) then begin
lSource := TIntegerArray(iSource);
Clear();
Resize(lSource.Count);
for i := 0 to Count-1 do begin
Items[i] := lSource.Items[i];
end;
end
else begin
inherited Assign(iSource);
end;
end;
class function TIntegerArray.GetItemType: PTypeInfo;
begin
result := TypeInfo(Integer);
end;
class function TIntegerArray.GetItemSize: integer;
begin
result := SizeOf(Integer);
end;
function TIntegerArray.GetItems(Index: integer): Integer;
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
result := fItems[Index];
end;
function TIntegerArray.GetItemRef(Index: integer): pointer;
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
result := @fItems[Index];
end;
procedure TIntegerArray.Clear;
begin
SetLength(fItems, 0);
FCount := 0;
end;
procedure TIntegerArray.Delete(Index: integer);
var i: integer;
begin
if (Index>=Count) then RaiseError(err_InvalidIndex, [Index]);
if (Index<Count-1) then
for i := Index to Count-2 do fItems[i] := fItems[i+1];
SetLength(fItems, Count-1);
Dec(FCount);
end;
procedure TIntegerArray.SetItems(Index: integer; const Value: Integer);
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
fItems[Index] := Value;
end;
procedure TIntegerArray.Resize(ElementCount: integer);
begin
SetLength(fItems, ElementCount);
FCount := ElementCount;
end;
function TIntegerArray.GetCount: integer;
begin
result := FCount;
end;
procedure TIntegerArray.Grow;
var
Delta, Capacity: Integer;
begin
Capacity := Length(fItems);
if Capacity > 64 then
Delta := Capacity div 4
else
if Capacity > 8 then
Delta := 16
else
Delta := 4;
SetLength(fItems, Capacity + Delta);
end;
function TIntegerArray.Add(const Value: Integer): integer;
begin
Result := Count;
if Length(fItems) = Result then
Grow;
fItems[result] := Value;
Inc(fCount);
end;
{ TStringArray }
procedure TStringArray.Assign(iSource: TPersistent);
var lSource:TStringArray;
i:integer;
begin
if (iSource is TStringArray) then begin
lSource := TStringArray(iSource);
Clear();
Resize(lSource.Count);
for i := 0 to Count-1 do begin
Items[i] := lSource.Items[i];
end;
end
else begin
inherited Assign(iSource);
end;
end;
class function TStringArray.GetItemType: PTypeInfo;
begin
result := TypeInfo(String);
end;
class function TStringArray.GetItemSize: integer;
begin
result := SizeOf(String);
end;
function TStringArray.GetItems(Index: integer): String;
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
result := fItems[Index];
end;
function TStringArray.GetItemRef(Index: integer): pointer;
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
result := @fItems[Index];
end;
procedure TStringArray.Clear;
begin
SetLength(fItems, 0);
FCount := 0;
end;
procedure TStringArray.Delete(Index: integer);
var i: integer;
begin
if (Index>=Count) then RaiseError(err_InvalidIndex, [Index]);
if (Index<Count-1) then
for i := Index to Count-2 do fItems[i] := fItems[i+1];
SetLength(fItems, Count-1);
Dec(FCount);
end;
procedure TStringArray.SetItems(Index: integer; const Value: String);
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
fItems[Index] := Value;
end;
procedure TStringArray.Resize(ElementCount: integer);
begin
SetLength(fItems, ElementCount);
FCount := ElementCount;
end;
function TStringArray.GetCount: integer;
begin
result := FCount;
end;
procedure TStringArray.Grow;
var
Delta, Capacity: Integer;
begin
Capacity := Length(fItems);
if Capacity > 64 then
Delta := Capacity div 4
else
if Capacity > 8 then
Delta := 16
else
Delta := 4;
SetLength(fItems, Capacity + Delta);
end;
function TStringArray.Add(const Value: String): integer;
begin
Result := Count;
if Length(fItems) = Result then
Grow;
fItems[result] := Value;
Inc(fCount);
end;
{ TPerson }
procedure TPerson.Assign(iSource: TPersistent);
var lSource: MegaDemoLibrary_Intf.TPerson;
begin
inherited Assign(iSource);
if (iSource is MegaDemoLibrary_Intf.TPerson) then begin
lSource := MegaDemoLibrary_Intf.TPerson(iSource);
FirstName := lSource.FirstName;
LastName := lSource.LastName;
Age := lSource.Age;
Sex := lSource.Sex;
end;
end;
{ TPersonCollection }
constructor TPersonCollection.Create;
begin
inherited Create(TPerson);
end;
constructor TPersonCollection.Create(aItemClass: TCollectionItemClass);
begin
inherited Create(aItemClass);
end;
function TPersonCollection.Add: TPerson;
begin
result := TPerson(inherited Add);
end;
function TPersonCollection.GetItems(Index: integer): TPerson;
begin
result := TPerson(inherited Items[Index]);
end;
procedure TPersonCollection.LoadFromArray(anArray: TPersonArray);
var i : integer;
begin
Clear;
for i := 0 to (anArray.Count-1) do
Add.Assign(anArray[i]);
end;
procedure TPersonCollection.SaveToArray(anArray: TPersonArray);
var i : integer;
begin
anArray.Clear;
anArray.Resize(Count);
for i := 0 to (Count-1) do begin
anArray[i] := TPerson.Create;
anArray[i].Assign(Items[i]);
end;
end;
procedure TPersonCollection.SetItems(Index: integer; const Value: TPerson);
begin
TPerson(inherited Items[Index]).Assign(Value);
end;
{ CoMegaDemoService }
class function CoMegaDemoService.Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): IMegaDemoService;
begin
result := TMegaDemoService_Proxy.Create(aMessage, aTransportChannel);
end;
{ TMegaDemoService_Proxy }
function TMegaDemoService_Proxy.__GetInterfaceName:string;
begin
result := 'MegaDemoService';
end;
function TMegaDemoService_Proxy.Sum(const A: Integer; const B: Integer): Integer;
begin
try
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'Sum');
__Message.Write('A', TypeInfo(Integer), A, []);
__Message.Write('B', TypeInfo(Integer), B, []);
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('Result', TypeInfo(Integer), result, []);
finally
__Message.FreeStream;
end
end;
function TMegaDemoService_Proxy.GetServerTime: DateTime;
begin
try
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'GetServerTime');
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('Result', TypeInfo(DateTime), result, [paIsDateTime]);
finally
__Message.FreeStream;
end
end;
procedure TMegaDemoService_Proxy.EchoPerson(const aPerson: TPerson; out anotherPerson: TPerson);
begin
try
anotherPerson := nil;
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'EchoPerson');
__Message.Write('aPerson', TypeInfo(MegaDemoLibrary_Intf.TPerson), aPerson, []);
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('anotherPerson', TypeInfo(MegaDemoLibrary_Intf.TPerson), anotherPerson, []);
finally
__Message.FreeStream;
end
end;
function TMegaDemoService_Proxy.TestIntegerArray(const anArray: TIntegerArray): TIntegerArray;
begin
try
result := nil;
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'TestIntegerArray');
__Message.Write('anArray', TypeInfo(MegaDemoLibrary_Intf.TIntegerArray), anArray, []);
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('Result', TypeInfo(MegaDemoLibrary_Intf.TIntegerArray), result, []);
finally
__Message.FreeStream;
end
end;
function TMegaDemoService_Proxy.TestStringArray(const anArray: TStringArray): TStringArray;
begin
try
result := nil;
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'TestStringArray');
__Message.Write('anArray', TypeInfo(MegaDemoLibrary_Intf.TStringArray), anArray, []);
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('Result', TypeInfo(MegaDemoLibrary_Intf.TStringArray), result, []);
finally
__Message.FreeStream;
end
end;
function TMegaDemoService_Proxy.TestPersonArray(const anArray: TPersonArray): TPersonArray;
begin
try
result := nil;
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'TestPersonArray');
__Message.Write('anArray', TypeInfo(MegaDemoLibrary_Intf.TPersonArray), anArray, []);
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('Result', TypeInfo(MegaDemoLibrary_Intf.TPersonArray), result, []);
finally
__Message.FreeStream;
end
end;
procedure TMegaDemoService_Proxy.EchoBinary(const BinIN: binary; out BinOUT: Binary);
begin
try
BinOUT := nil;
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'EchoBinary');
__Message.Write('BinIN', TypeInfo(binary), BinIN, []);
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('BinOUT', TypeInfo(Binary), BinOUT, []);
finally
__Message.FreeStream;
end
end;
procedure TMegaDemoService_Proxy.SomeTypes(var aString: String; var aWidestring: Widestring; var anInteger: Integer; var aCurrency: Currency; var aDatetime: DateTime);
begin
try
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'SomeTypes');
__Message.Write('aString', TypeInfo(String), aString, []);
__Message.Write('aWidestring', TypeInfo(Widestring), aWidestring, []);
__Message.Write('anInteger', TypeInfo(Integer), anInteger, []);
__Message.Write('aCurrency', TypeInfo(Currency), aCurrency, []);
__Message.Write('aDatetime', TypeInfo(DateTime), aDatetime, [paIsDateTime]);
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('aString', TypeInfo(String), aString, []);
__Message.Read('aWidestring', TypeInfo(Widestring), aWidestring, []);
__Message.Read('anInteger', TypeInfo(Integer), anInteger, []);
__Message.Read('aCurrency', TypeInfo(Currency), aCurrency, []);
__Message.Read('aDatetime', TypeInfo(DateTime), aDatetime, [paIsDateTime]);
finally
__Message.FreeStream;
end
end;
function TMegaDemoService_Proxy.CustomObjectAsString: String;
begin
try
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'CustomObjectAsString');
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('Result', TypeInfo(String), result, []);
finally
__Message.FreeStream;
end
end;
function TMegaDemoService_Proxy.CustomObjectAsStream: Binary;
begin
try
result := nil;
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'CustomObjectAsStream');
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
__Message.Read('Result', TypeInfo(Binary), result, []);
finally
__Message.FreeStream;
end
end;
procedure TMegaDemoService_Proxy.RaiseError;
begin
try
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'RaiseError');
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
finally
__Message.FreeStream;
end
end;
procedure TMegaDemoService_Proxy.RaiseTestException;
begin
try
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'RaiseTestException');
__Message.Finalize;
__TransportChannel.Dispatch(__Message);
finally
__Message.FreeStream;
end
end;
initialization
RegisterROClass(TPerson);
RegisterROClass(TPersonArray);
RegisterROClass(TIntegerArray);
RegisterROClass(TStringArray);
RegisterExceptionClass(ETestException);
RegisterProxyClass(IMegaDemoService_IID, TMegaDemoService_Proxy);
finalization
UnregisterROClass(TPerson);
UnregisterROClass(TPersonArray);
UnregisterROClass(TIntegerArray);
UnregisterROClass(TStringArray);
UnregisterExceptionClass(ETestException);
UnregisterProxyClass(IMegaDemoService_IID);
end.