1094 lines
33 KiB
ObjectPascal
1094 lines
33 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. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I Remobjects.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{vcl:} Classes, TypInfo,
|
|
{RemObjects:} uROXMLIntf, uROClasses, uROClient, uROTypes, uROClientIntf;
|
|
|
|
const
|
|
{ Library ID }
|
|
LibraryUID = '{D9821C1A-A084-4120-93F3-BCE6CF2AE0F4}';
|
|
TargetNamespace = '';
|
|
|
|
{ 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: AnsiString;
|
|
fLastName: AnsiString;
|
|
fAge: Integer;
|
|
fSex: TSex;
|
|
public
|
|
procedure Assign(iSource: TPersistent); override;
|
|
procedure ReadComplex(ASerializer: TObject); override;
|
|
procedure WriteComplex(ASerializer: TObject); override;
|
|
published
|
|
property FirstName:AnsiString read fFirstName write fFirstName;
|
|
property LastName:AnsiString 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(aIndex: integer): TPerson;
|
|
procedure SetItems(aIndex: 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_TPerson = array of TPerson;
|
|
TPersonArray = class(TROArray)
|
|
private
|
|
fCount: Integer;
|
|
fItems : TPersonArray_TPerson;
|
|
protected
|
|
procedure Grow; virtual;
|
|
function GetItems(aIndex: integer): TPerson;
|
|
procedure SetItems(aIndex: 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(aIndex: integer): pointer; override;
|
|
procedure SetItemRef(aIndex: integer; Ref: pointer); override;
|
|
procedure Clear; override;
|
|
procedure Delete(aIndex: integer); override;
|
|
procedure Resize(ElementCount: integer); override;
|
|
|
|
procedure Assign(iSource:TPersistent); override;
|
|
procedure ReadComplex(ASerializer: TObject); override;
|
|
procedure WriteComplex(ASerializer: TObject); 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;
|
|
property InnerArray: TPersonArray_TPerson read fItems;
|
|
end;
|
|
|
|
{ TIntegerArray }
|
|
TIntegerArray_Integer = array of Integer;
|
|
TIntegerArray = class(TROArray)
|
|
private
|
|
fCount: Integer;
|
|
fItems : TIntegerArray_Integer;
|
|
protected
|
|
procedure Grow; virtual;
|
|
function GetItems(aIndex: integer): Integer;
|
|
procedure SetItems(aIndex: integer; const Value: Integer);
|
|
function GetCount: integer; override;
|
|
public
|
|
class function GetItemType: PTypeInfo; override;
|
|
class function GetItemSize: integer; override;
|
|
|
|
function GetItemRef(aIndex: integer): pointer; override;
|
|
procedure Clear; override;
|
|
procedure Delete(aIndex: integer); override;
|
|
procedure Resize(ElementCount: integer); override;
|
|
|
|
procedure Assign(iSource:TPersistent); override;
|
|
procedure ReadComplex(ASerializer: TObject); override;
|
|
procedure WriteComplex(ASerializer: TObject); override;
|
|
function Add(const Value:Integer): integer;
|
|
function GetIndex(const aPropertyName : string;
|
|
const aPropertyValue : Variant;
|
|
StartFrom : integer = 0;
|
|
Options : TROSearchOptions = [soIgnoreCase]) : integer; override;
|
|
|
|
property Count : integer read GetCount;
|
|
property Items[Index: integer]:Integer read GetItems write SetItems; default;
|
|
property InnerArray: TIntegerArray_Integer read fItems;
|
|
end;
|
|
|
|
{ TStringArray }
|
|
TStringArray_AnsiString = array of AnsiString;
|
|
TStringArray = class(TROArray)
|
|
private
|
|
fCount: Integer;
|
|
fItems : TStringArray_AnsiString;
|
|
protected
|
|
procedure Grow; virtual;
|
|
function GetItems(aIndex: integer): AnsiString;
|
|
procedure SetItems(aIndex: integer; const Value: AnsiString);
|
|
function GetCount: integer; override;
|
|
public
|
|
class function GetItemType: PTypeInfo; override;
|
|
class function GetItemSize: integer; override;
|
|
|
|
function GetItemRef(aIndex: integer): pointer; override;
|
|
procedure Clear; override;
|
|
procedure Delete(aIndex: integer); override;
|
|
procedure Resize(ElementCount: integer); override;
|
|
|
|
procedure Assign(iSource:TPersistent); override;
|
|
procedure ReadComplex(ASerializer: TObject); override;
|
|
procedure WriteComplex(ASerializer: TObject); override;
|
|
function Add(const Value:AnsiString): integer;
|
|
function GetIndex(const aPropertyName : string;
|
|
const aPropertyValue : Variant;
|
|
StartFrom : integer = 0;
|
|
Options : TROSearchOptions = [soIgnoreCase]) : integer; override;
|
|
|
|
property Count : integer read GetCount;
|
|
property Items[Index: integer]:AnsiString read GetItems write SetItems; default;
|
|
property InnerArray: TStringArray_AnsiString read fItems;
|
|
end;
|
|
|
|
{ Exceptions }
|
|
ETestException = class(EROException)
|
|
private
|
|
fErrorCode: Integer;
|
|
fAdditionalInfo: AnsiString;
|
|
public
|
|
constructor Create(anExceptionMessage : string; aErrorCode: Integer; aAdditionalInfo: AnsiString);
|
|
procedure ReadException(ASerializer: TObject); override;
|
|
procedure WriteException(ASerializer: TObject); override;
|
|
published
|
|
property ErrorCode: Integer read fErrorCode write fErrorCode;
|
|
property AdditionalInfo: AnsiString 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, uROSerializer, uRORes;
|
|
|
|
{ ETestException }
|
|
|
|
constructor ETestException.Create(anExceptionMessage : string; aErrorCode: Integer;
|
|
aAdditionalInfo: AnsiString);
|
|
begin
|
|
inherited Create(anExceptionMessage);
|
|
|
|
fErrorCode := aErrorCode;
|
|
fAdditionalInfo := aAdditionalInfo;
|
|
end;
|
|
|
|
procedure ETestException.ReadException(ASerializer: TObject);
|
|
var
|
|
l_AdditionalInfo: AnsiString;
|
|
l_ErrorCode: Integer;
|
|
begin
|
|
if TROSerializer(ASerializer).RecordStrictOrder then begin
|
|
l_ErrorCode := ErrorCode;
|
|
TROSerializer(ASerializer).ReadInteger('ErrorCode', otSLong, l_ErrorCode);
|
|
ErrorCode := l_ErrorCode;
|
|
l_AdditionalInfo := AdditionalInfo;
|
|
TROSerializer(ASerializer).ReadUTF8String('AdditionalInfo', l_AdditionalInfo);
|
|
AdditionalInfo := l_AdditionalInfo;
|
|
end
|
|
else begin
|
|
l_AdditionalInfo := AdditionalInfo;
|
|
TROSerializer(ASerializer).ReadUTF8String('AdditionalInfo', l_AdditionalInfo);
|
|
AdditionalInfo := l_AdditionalInfo;
|
|
l_ErrorCode := ErrorCode;
|
|
TROSerializer(ASerializer).ReadInteger('ErrorCode', otSLong, l_ErrorCode);
|
|
ErrorCode := l_ErrorCode;
|
|
end;
|
|
end;
|
|
|
|
procedure ETestException.WriteException(ASerializer: TObject);
|
|
var
|
|
l_AdditionalInfo: AnsiString;
|
|
l_ErrorCode: Integer;
|
|
begin
|
|
if TROSerializer(ASerializer).RecordStrictOrder then begin
|
|
TROSerializer(ASerializer).ChangeClass(ETestException);
|
|
l_ErrorCode := ErrorCode;
|
|
TROSerializer(ASerializer).WriteInteger('ErrorCode', otSLong, l_ErrorCode);
|
|
l_AdditionalInfo := AdditionalInfo;
|
|
TROSerializer(ASerializer).WriteUTF8String('AdditionalInfo', l_AdditionalInfo);
|
|
end
|
|
else begin
|
|
l_AdditionalInfo := AdditionalInfo;
|
|
TROSerializer(ASerializer).WriteUTF8String('AdditionalInfo', l_AdditionalInfo);
|
|
l_ErrorCode := ErrorCode;
|
|
TROSerializer(ASerializer).WriteInteger('ErrorCode', otSLong, l_ErrorCode);
|
|
end;
|
|
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].Assign(lSource.Items[i]);
|
|
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(aIndex: integer): TPerson;
|
|
begin
|
|
if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);
|
|
result := fItems[aIndex];
|
|
end;
|
|
|
|
function TPersonArray.GetItemRef(aIndex: integer): pointer;
|
|
begin
|
|
if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);
|
|
result := fItems[aIndex];
|
|
end;
|
|
|
|
procedure TPersonArray.SetItemRef(aIndex: integer; Ref: pointer);
|
|
begin
|
|
if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);
|
|
if Ref <> fItems[aIndex] then begin
|
|
if fItems[aIndex] <> nil then fItems[aIndex].Free;
|
|
fItems[aIndex] := Ref;
|
|
end;
|
|
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(aIndex: integer);
|
|
var i: integer;
|
|
begin
|
|
if (aIndex>=Count) then RaiseError(err_InvalidIndex, [aIndex]);
|
|
|
|
fItems[aIndex].Free();
|
|
|
|
if (aIndex<Count-1) then
|
|
for i := aIndex to Count-2 do fItems[i] := fItems[i+1];
|
|
|
|
SetLength(fItems, Count-1);
|
|
Dec(FCount);
|
|
end;
|
|
|
|
procedure TPersonArray.SetItems(aIndex: integer; const Value: TPerson);
|
|
begin
|
|
if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);
|
|
if fItems[aIndex] <> Value then begin
|
|
fItems[aIndex].Free;
|
|
fItems[aIndex] := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TPersonArray.Resize(ElementCount: integer);
|
|
var i: Integer;
|
|
begin
|
|
if fCount = ElementCount then Exit;
|
|
for i := FCount -1 downto ElementCount do
|
|
FItems[i].Free;
|
|
SetLength(fItems, ElementCount);
|
|
for i := FCount to ElementCount -1 do
|
|
FItems[i] := TPerson.Create;
|
|
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;
|
|
|
|
procedure TPersonArray.ReadComplex(ASerializer: TObject);
|
|
var
|
|
lval: TPerson;
|
|
i: integer;
|
|
begin
|
|
for i := 0 to Count-1 do begin
|
|
with TROSerializer(ASerializer) do
|
|
ReadStruct(GetArrayElementName(GetItemType, GetItemRef(i)), TPerson, lval, i);
|
|
Items[i] := lval;
|
|
end;
|
|
end;
|
|
|
|
procedure TPersonArray.WriteComplex(ASerializer: TObject);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to Count-1 do
|
|
with TROSerializer(ASerializer) do
|
|
WriteStruct(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], TPerson, i);
|
|
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(aIndex: integer): Integer;
|
|
begin
|
|
if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);
|
|
result := fItems[aIndex];
|
|
end;
|
|
|
|
function TIntegerArray.GetItemRef(aIndex: integer): pointer;
|
|
begin
|
|
if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);
|
|
result := @fItems[aIndex];
|
|
end;
|
|
|
|
procedure TIntegerArray.Clear;
|
|
begin
|
|
SetLength(fItems, 0);
|
|
FCount := 0;
|
|
end;
|
|
|
|
procedure TIntegerArray.Delete(aIndex: integer);
|
|
var i: integer;
|
|
begin
|
|
if (aIndex>=Count) then RaiseError(err_InvalidIndex, [aIndex]);
|
|
|
|
if (aIndex<Count-1) then
|
|
for i := aIndex to Count-2 do fItems[i] := fItems[i+1];
|
|
|
|
SetLength(fItems, Count-1);
|
|
Dec(FCount);
|
|
end;
|
|
|
|
procedure TIntegerArray.SetItems(aIndex: integer; const Value: Integer);
|
|
begin
|
|
if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);
|
|
fItems[aIndex] := Value;
|
|
end;
|
|
|
|
procedure TIntegerArray.Resize(ElementCount: integer);
|
|
begin
|
|
if fCount = ElementCount then Exit;
|
|
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;
|
|
|
|
function TIntegerArray.GetIndex(const aPropertyName: string;
|
|
const aPropertyValue: Variant; StartFrom: integer;
|
|
Options: TROSearchOptions): integer;
|
|
begin
|
|
result := -1;
|
|
end;
|
|
|
|
procedure TIntegerArray.ReadComplex(ASerializer: TObject);
|
|
var
|
|
lval: Integer;
|
|
i: integer;
|
|
begin
|
|
for i := 0 to Count-1 do begin
|
|
with TROSerializer(ASerializer) do
|
|
ReadInteger(GetArrayElementName(GetItemType, GetItemRef(i)), otSLong, lval, i);
|
|
Items[i] := lval;
|
|
end;
|
|
end;
|
|
|
|
procedure TIntegerArray.WriteComplex(ASerializer: TObject);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to Count-1 do
|
|
with TROSerializer(ASerializer) do
|
|
WriteInteger(GetArrayElementName(GetItemType, GetItemRef(i)), otSLong, fItems[i], i);
|
|
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(AnsiString);
|
|
end;
|
|
|
|
class function TStringArray.GetItemSize: integer;
|
|
begin
|
|
result := SizeOf(AnsiString);
|
|
end;
|
|
|
|
function TStringArray.GetItems(aIndex: integer): AnsiString;
|
|
begin
|
|
if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);
|
|
result := fItems[aIndex];
|
|
end;
|
|
|
|
function TStringArray.GetItemRef(aIndex: integer): pointer;
|
|
begin
|
|
if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);
|
|
result := @fItems[aIndex];
|
|
end;
|
|
|
|
procedure TStringArray.Clear;
|
|
begin
|
|
SetLength(fItems, 0);
|
|
FCount := 0;
|
|
end;
|
|
|
|
procedure TStringArray.Delete(aIndex: integer);
|
|
var i: integer;
|
|
begin
|
|
if (aIndex>=Count) then RaiseError(err_InvalidIndex, [aIndex]);
|
|
|
|
if (aIndex<Count-1) then
|
|
for i := aIndex to Count-2 do fItems[i] := fItems[i+1];
|
|
|
|
SetLength(fItems, Count-1);
|
|
Dec(FCount);
|
|
end;
|
|
|
|
procedure TStringArray.SetItems(aIndex: integer; const Value: AnsiString);
|
|
begin
|
|
if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);
|
|
fItems[aIndex] := Value;
|
|
end;
|
|
|
|
procedure TStringArray.Resize(ElementCount: integer);
|
|
begin
|
|
if fCount = ElementCount then Exit;
|
|
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: AnsiString): integer;
|
|
begin
|
|
Result := Count;
|
|
if Length(fItems) = Result then
|
|
Grow;
|
|
fItems[result] := Value;
|
|
Inc(fCount);
|
|
end;
|
|
|
|
function TStringArray.GetIndex(const aPropertyName: string;
|
|
const aPropertyValue: Variant; StartFrom: integer;
|
|
Options: TROSearchOptions): integer;
|
|
begin
|
|
result := -1;
|
|
end;
|
|
|
|
procedure TStringArray.ReadComplex(ASerializer: TObject);
|
|
var
|
|
lval: AnsiString;
|
|
i: integer;
|
|
begin
|
|
for i := 0 to Count-1 do begin
|
|
with TROSerializer(ASerializer) do
|
|
ReadUTF8String(GetArrayElementName(GetItemType, GetItemRef(i)), lval, i);
|
|
Items[i] := lval;
|
|
end;
|
|
end;
|
|
|
|
procedure TStringArray.WriteComplex(ASerializer: TObject);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to Count-1 do
|
|
with TROSerializer(ASerializer) do
|
|
WriteUTF8String(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], i);
|
|
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;
|
|
|
|
procedure TPerson.ReadComplex(ASerializer: TObject);
|
|
var
|
|
l_Age: Integer;
|
|
l_FirstName: AnsiString;
|
|
l_LastName: AnsiString;
|
|
l_Sex: TSex;
|
|
begin
|
|
if TROSerializer(ASerializer).RecordStrictOrder then begin
|
|
l_FirstName := FirstName;
|
|
TROSerializer(ASerializer).ReadUTF8String('FirstName', l_FirstName);
|
|
FirstName := l_FirstName;
|
|
l_LastName := LastName;
|
|
TROSerializer(ASerializer).ReadUTF8String('LastName', l_LastName);
|
|
LastName := l_LastName;
|
|
l_Age := Age;
|
|
TROSerializer(ASerializer).ReadInteger('Age', otSLong, l_Age);
|
|
Age := l_Age;
|
|
l_Sex := Sex;
|
|
TROSerializer(ASerializer).ReadEnumerated('Sex',TypeInfo(TSex), l_Sex);
|
|
Sex := l_Sex;
|
|
end
|
|
else begin
|
|
l_Age := Age;
|
|
TROSerializer(ASerializer).ReadInteger('Age', otSLong, l_Age);
|
|
Age := l_Age;
|
|
l_FirstName := FirstName;
|
|
TROSerializer(ASerializer).ReadUTF8String('FirstName', l_FirstName);
|
|
FirstName := l_FirstName;
|
|
l_LastName := LastName;
|
|
TROSerializer(ASerializer).ReadUTF8String('LastName', l_LastName);
|
|
LastName := l_LastName;
|
|
l_Sex := Sex;
|
|
TROSerializer(ASerializer).ReadEnumerated('Sex',TypeInfo(TSex), l_Sex);
|
|
Sex := l_Sex;
|
|
end;
|
|
end;
|
|
|
|
procedure TPerson.WriteComplex(ASerializer: TObject);
|
|
var
|
|
l_Age: Integer;
|
|
l_FirstName: AnsiString;
|
|
l_LastName: AnsiString;
|
|
l_Sex: TSex;
|
|
begin
|
|
if TROSerializer(ASerializer).RecordStrictOrder then begin
|
|
TROSerializer(ASerializer).ChangeClass(TPerson);
|
|
l_FirstName := FirstName;
|
|
TROSerializer(ASerializer).WriteUTF8String('FirstName', l_FirstName);
|
|
l_LastName := LastName;
|
|
TROSerializer(ASerializer).WriteUTF8String('LastName', l_LastName);
|
|
l_Age := Age;
|
|
TROSerializer(ASerializer).WriteInteger('Age', otSLong, l_Age);
|
|
l_Sex := Sex;
|
|
TROSerializer(ASerializer).WriteEnumerated('Sex',TypeInfo(TSex), l_Sex);
|
|
end
|
|
else begin
|
|
l_Age := Age;
|
|
TROSerializer(ASerializer).WriteInteger('Age', otSLong, l_Age);
|
|
l_FirstName := FirstName;
|
|
TROSerializer(ASerializer).WriteUTF8String('FirstName', l_FirstName);
|
|
l_LastName := LastName;
|
|
TROSerializer(ASerializer).WriteUTF8String('LastName', l_LastName);
|
|
l_Sex := Sex;
|
|
TROSerializer(ASerializer).WriteEnumerated('Sex',TypeInfo(TSex), l_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(aIndex: integer): TPerson;
|
|
begin
|
|
result := TPerson(inherited Items[aIndex]);
|
|
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(aIndex: integer; const Value: TPerson);
|
|
begin
|
|
TPerson(inherited Items[aIndex]).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
|
|
__Message.SetAttributes(__TransportChannel, ['EA_Model'],
|
|
['C:\Dev\ROSDK3\Tests\MegaDemo\NewLibrary.eap']);
|
|
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.UnsetAttributes(__TransportChannel);
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
function TMegaDemoService_Proxy.GetServerTime: DateTime;
|
|
begin
|
|
__Message.SetAttributes(__TransportChannel, ['EA_Model'],
|
|
['C:\Dev\ROSDK3\Tests\MegaDemo\NewLibrary.eap']);
|
|
try
|
|
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'GetServerTime');
|
|
__Message.Finalize;
|
|
|
|
__TransportChannel.Dispatch(__Message);
|
|
|
|
__Message.Read('Result', TypeInfo(DateTime), result, [paIsDateTime]);
|
|
finally
|
|
__Message.UnsetAttributes(__TransportChannel);
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
procedure TMegaDemoService_Proxy.EchoPerson(const aPerson: TPerson; out anotherPerson: TPerson);
|
|
begin
|
|
__Message.SetAttributes(__TransportChannel, ['EA_Model'],
|
|
['C:\Dev\ROSDK3\Tests\MegaDemo\NewLibrary.eap']);
|
|
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.UnsetAttributes(__TransportChannel);
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
function TMegaDemoService_Proxy.TestIntegerArray(const anArray: TIntegerArray): TIntegerArray;
|
|
begin
|
|
__Message.SetAttributes(__TransportChannel, ['EA_Model'],
|
|
['C:\Dev\ROSDK3\Tests\MegaDemo\NewLibrary.eap']);
|
|
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.UnsetAttributes(__TransportChannel);
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
function TMegaDemoService_Proxy.TestStringArray(const anArray: TStringArray): TStringArray;
|
|
begin
|
|
__Message.SetAttributes(__TransportChannel, ['EA_Model'],
|
|
['C:\Dev\ROSDK3\Tests\MegaDemo\NewLibrary.eap']);
|
|
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.UnsetAttributes(__TransportChannel);
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
function TMegaDemoService_Proxy.TestPersonArray(const anArray: TPersonArray): TPersonArray;
|
|
begin
|
|
__Message.SetAttributes(__TransportChannel, ['EA_Model'],
|
|
['C:\Dev\ROSDK3\Tests\MegaDemo\NewLibrary.eap']);
|
|
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.UnsetAttributes(__TransportChannel);
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
procedure TMegaDemoService_Proxy.EchoBinary(const BinIN: binary; out BinOUT: Binary);
|
|
begin
|
|
__Message.SetAttributes(__TransportChannel, ['EA_Model'],
|
|
['C:\Dev\ROSDK3\Tests\MegaDemo\NewLibrary.eap']);
|
|
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.UnsetAttributes(__TransportChannel);
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
procedure TMegaDemoService_Proxy.SomeTypes(var aString: String; var aWidestring: Widestring; var anInteger: Integer; var aCurrency: Currency; var aDatetime: DateTime);
|
|
begin
|
|
__Message.SetAttributes(__TransportChannel, ['EA_Model'],
|
|
['C:\Dev\ROSDK3\Tests\MegaDemo\NewLibrary.eap']);
|
|
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.UnsetAttributes(__TransportChannel);
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
function TMegaDemoService_Proxy.CustomObjectAsString: String;
|
|
begin
|
|
__Message.SetAttributes(__TransportChannel, ['EA_Model'],
|
|
['C:\Dev\ROSDK3\Tests\MegaDemo\NewLibrary.eap']);
|
|
try
|
|
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'CustomObjectAsString');
|
|
__Message.Finalize;
|
|
|
|
__TransportChannel.Dispatch(__Message);
|
|
|
|
__Message.Read('Result', TypeInfo(String), result, []);
|
|
finally
|
|
__Message.UnsetAttributes(__TransportChannel);
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
function TMegaDemoService_Proxy.CustomObjectAsStream: Binary;
|
|
begin
|
|
__Message.SetAttributes(__TransportChannel, ['EA_Model'],
|
|
['C:\Dev\ROSDK3\Tests\MegaDemo\NewLibrary.eap']);
|
|
try
|
|
result := nil;
|
|
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'CustomObjectAsStream');
|
|
__Message.Finalize;
|
|
|
|
__TransportChannel.Dispatch(__Message);
|
|
|
|
__Message.Read('Result', TypeInfo(Binary), result, []);
|
|
finally
|
|
__Message.UnsetAttributes(__TransportChannel);
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
procedure TMegaDemoService_Proxy.RaiseError;
|
|
begin
|
|
__Message.SetAttributes(__TransportChannel, ['EA_Model'],
|
|
['C:\Dev\ROSDK3\Tests\MegaDemo\NewLibrary.eap']);
|
|
try
|
|
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'RaiseError');
|
|
__Message.Finalize;
|
|
|
|
__TransportChannel.Dispatch(__Message);
|
|
|
|
finally
|
|
__Message.UnsetAttributes(__TransportChannel);
|
|
__Message.FreeStream;
|
|
end
|
|
end;
|
|
|
|
procedure TMegaDemoService_Proxy.RaiseTestException;
|
|
begin
|
|
__Message.SetAttributes(__TransportChannel, ['EA_Model'],
|
|
['C:\Dev\ROSDK3\Tests\MegaDemo\NewLibrary.eap']);
|
|
try
|
|
__Message.InitializeRequestMessage(__TransportChannel, 'MegaDemoLibrary', __InterfaceName, 'RaiseTestException');
|
|
__Message.Finalize;
|
|
|
|
__TransportChannel.Dispatch(__Message);
|
|
|
|
finally
|
|
__Message.UnsetAttributes(__TransportChannel);
|
|
__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.
|