david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
1991 lines
94 KiB
ObjectPascal
1991 lines
94 KiB
ObjectPascal
unit uRODLToPascalIntf;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - CodeGen }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$IFDEF LINUX}
|
|
{$I ../RemObjects.inc}
|
|
{$ELSE}
|
|
{$I ..\RemObjects.inc}
|
|
{$ENDIF LINUX}
|
|
|
|
interface
|
|
|
|
uses Classes, uRODL;
|
|
|
|
type { TRODLToIntf }
|
|
TRODLToIntf = class(TRODLConverter)
|
|
private
|
|
fUnitName : string;
|
|
|
|
procedure WriteTypeDeclaration(aLibrary: TRODLLibrary; aType: TRODLEntity);
|
|
procedure WriteServiceDeclaration(aService: TRODLService);
|
|
procedure WriteEventSinkDeclaration(aEventSink: TRODLEventSink);
|
|
procedure WriteCoClass(aLibrary : TRODLLibrary; aService: TRODLService);
|
|
procedure WriteServiceConsts(aService : TRODLService);
|
|
procedure WriteArraySerializer(aLibrary : TRODLLibrary; anArray : TRODLArray);
|
|
procedure WriteStructPropMethods(aLibrary : TRODLLibrary; aStruct: TRODLStruct);
|
|
procedure WriteAttributesMethods(anEntity: TRODLEntity);
|
|
|
|
procedure WriteDocumentation(aInfo: TRODLEntity);
|
|
|
|
function IsSOAPService(aService : TRODLService) : boolean;
|
|
procedure WriteEventSink(aLibrary : TRODLLibrary; aEventSink: TRODLEventSink);
|
|
procedure GetInheritedExceptionFields(const aLibrary: TRODLLibrary; anException: TRODLException; aList: TList);
|
|
function AdjustParamList(const aParamList: string; Indentation: integer): string;
|
|
procedure WriteOperationDocumentation(anOperation:TRODLOperation; IndentationLevel : integer);
|
|
|
|
protected
|
|
procedure IntConvert(const aLibrary : TRODLLibrary; const aTargetEntity : string = ''); override;
|
|
|
|
public
|
|
constructor Create(const aLibraryFile:string; iUnitName:string=''); reintroduce; overload; virtual;
|
|
constructor Create(const aLibrary : TRODLLibrary; iUnitName:string=''); reintroduce; overload; virtual;
|
|
class function GetTargetFileName(const aLibrary : TRODLLibrary; const aTargetEntity : string = ''): string; override;
|
|
|
|
end;
|
|
|
|
function GetDataType(const aType: string): String;
|
|
function GetAttributes(atOperation, atService, atLibrary: TStrings; Ident: Integer): string;
|
|
|
|
implementation
|
|
|
|
uses SysUtils, Dialogs, uROTypes, //Controls,
|
|
{$IFDEF DELPHI5}
|
|
ComObj,
|
|
{$ENDIF}
|
|
uRODLGenTools, uRODLToPascal, uROClasses, uROSerializer;
|
|
|
|
{ TRODLToIntf }
|
|
|
|
function GetDataType(const aType: string): String;
|
|
begin
|
|
case StrToDataType(aType) of
|
|
rtXML: result := 'IXmlNode';
|
|
else
|
|
result := aType;
|
|
end;
|
|
end;
|
|
|
|
constructor TRODLToIntf.Create(const aLibraryFile: string; iUnitName: string);
|
|
begin
|
|
fUnitName := iUnitName;
|
|
inherited Create(aLibraryFile);
|
|
end;
|
|
|
|
constructor TRODLToIntf.Create(const aLibrary: TRODLLibrary; iUnitName: string);
|
|
begin
|
|
fUnitName := iUnitName;
|
|
inherited Create(aLibrary);
|
|
end;
|
|
|
|
procedure TRODLToIntf.GetInheritedExceptionFields(const aLibrary: TRODLLibrary;
|
|
anException: TRODLException; aList: TList);
|
|
var ex : TRODLException;
|
|
i : integer;
|
|
begin
|
|
aList.Clear;
|
|
ex := anException;
|
|
|
|
repeat
|
|
ex := aLibrary.FindException(ex.Ancestor);
|
|
if (ex=NIL) then Exit;
|
|
|
|
for i := (ex.Count-1) downto 0 do
|
|
aList.Insert(0, ex[i]);
|
|
|
|
until 1=2;
|
|
end;
|
|
|
|
function TRODLToIntf.AdjustParamList(const aParamList : string; Indentation : integer) : string;
|
|
var i, k, cnt : integer;
|
|
begin
|
|
result := aParamList;
|
|
cnt := 1;
|
|
i := 1;
|
|
|
|
while (i<Length(result)) do begin
|
|
Inc(cnt);
|
|
Inc(i);
|
|
|
|
if (cnt>80) and ((result[i-1]=';') or (result[i-1]=',')) then begin
|
|
cnt := 1;
|
|
Insert(#13#10, result, i);
|
|
for k := 1 to Indentation do begin
|
|
Insert(#32, result, i+2);
|
|
end;
|
|
Inc(i, Indentation+2);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLToIntf.IntConvert(const aLibrary: TRODLLibrary; const aTargetEntity: string);
|
|
var l, x, i, k : integer;
|
|
s, s2: string;
|
|
fulllist: TStrings;
|
|
svc : TRODLService;
|
|
roexception : TRODLException;
|
|
roexceptionEntityList: IROStrings;
|
|
roexceptionEntity: TRODLTypedEntity;
|
|
inheritedfields : TList;
|
|
lPascalIndentationLevel: Integer;
|
|
begin
|
|
inheritedfields := TList.Create;
|
|
try
|
|
if fUnitName = '' then begin
|
|
fUnitName := ChangeFileExt(GetTargetFileName(aLibrary), '');
|
|
end;
|
|
|
|
Write(Format('unit %s;', [fUnitName]));
|
|
WriteEmptyLine;
|
|
|
|
WriteLines(IntfInvkNotice);
|
|
WriteEmptyLine;
|
|
|
|
Write('{$I Remobjects.inc}');
|
|
WriteEmptyLine;
|
|
|
|
Write('interface');
|
|
WriteEmptyLine;
|
|
|
|
Write('uses');
|
|
Write('{vcl:} Classes, TypInfo,',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
if aLibrary.UseCount > 0 then begin
|
|
Write('{RemObjects:} uROXMLIntf, uROClasses, uROClient, uROTypes, uROClientIntf,',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
s := '';
|
|
l := 0;
|
|
|
|
fulllist := TStringList.Create;
|
|
try
|
|
for i := 0 to aLibrary.UseCount-1 do begin
|
|
|
|
if aLibrary.Use[i].LoadedRodlLibraryName <> '' then
|
|
s2 := aLibrary.Use[i].LoadedRodlLibraryName + '_Intf'
|
|
else
|
|
s2 := ChangeFileExt(ExtractFilename(aLibrary.Use[i].RodlFile),'')+'_Intf';
|
|
if fulllist.IndexOf(s2) > -1 then
|
|
Continue;
|
|
|
|
if s <> '' then s := s+', ';
|
|
Inc(l, Length(s2));
|
|
|
|
s := s+s2;
|
|
fulllist.Add(s2);
|
|
|
|
if (l>80) then begin
|
|
|
|
if i <> aLibrary.UseCount -1 then s := s+ ',';
|
|
|
|
Write('{Used RODLs:} '+ s,PASCAL_INDENTATION_LEVEL_1);
|
|
s := '';
|
|
l := 0;
|
|
|
|
end;
|
|
|
|
end; { for }
|
|
finally
|
|
FreeAndNil(fulllist);
|
|
end;
|
|
s := s+';';
|
|
|
|
Write('{Used RODLs:} '+
|
|
|
|
s,PASCAL_INDENTATION_LEVEL_1);
|
|
end
|
|
else begin
|
|
Write('{RemObjects:} uROXMLIntf, uROClasses, uROClient, uROTypes, uROClientIntf;',PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
|
|
|
|
WriteEmptyLine;
|
|
|
|
Write('const');
|
|
Write('{ Library ID }',PASCAL_INDENTATION_LEVEL_1);
|
|
Write(Format('LibraryUID = ''%s'';', [GUIDToString(aLibrary.Info.UID)]),PASCAL_INDENTATION_LEVEL_1);
|
|
if (aLibrary.Info.Attributes.Values['Wsdl']<>'')
|
|
then Write(Format('WSDLLocation = ''%s'';', [aLibrary.Info.Attributes.Values['Wsdl']]),PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
|
|
Write(Format('TargetNamespace = ''%s'';', [aLibrary.Info.Attributes.Values['TargetNamespace']]),PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
WriteEmptyLine;
|
|
|
|
Write('{ Service Interface ID''s }',PASCAL_INDENTATION_LEVEL_1);
|
|
for i := 0 to (aLibrary.Count-1) do
|
|
if (aLibrary.Items[i] is TRODLService) and not aLibrary.Items[i].IsFromUsedRodl then begin
|
|
svc := TRODLService(aLibrary.Items[i]);
|
|
Write('I'+aLibrary.Items[i].Info.Name+'_IID : TGUID = '''+GUIDToString(svc.Default.Info.UID)+''';' ,PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
|
|
for i := 0 to (aLibrary.ServiceCount-1) do begin
|
|
if not aLibrary.Services[i].IsFromUsedRodl then begin
|
|
WriteServiceConsts(aLibrary.Services[i]);
|
|
end;
|
|
end;
|
|
WriteEmptyLine();
|
|
|
|
{-------- Events ----------}
|
|
Write('{ Event ID''s }',PASCAL_INDENTATION_LEVEL_1);
|
|
for i := 0 to (aLibrary.EventSinkCount-1) do begin
|
|
if not aLibrary.EventSinks[i].IsFromUsedRodl then begin
|
|
Write(Format('EID_%s = ''%s'';', [aLibrary.EventSinks[i].Info.Name, aLibrary.EventSinks[i].Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
end;
|
|
WriteEmptyLine();
|
|
{--------------------------}
|
|
|
|
if aLibrary.Count > 0 then Write('type');
|
|
|
|
with aLibrary do begin
|
|
// Forward declarations
|
|
Write('{ Forward declarations }',PASCAL_INDENTATION_LEVEL_1);
|
|
for i := 0 to (aLibrary.ServiceCount-1) do if (not aLibrary.Services[i].IsFromUsedRodl) then
|
|
Write(Format('I%s = interface;', [aLibrary.Services[i].Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
if aLibrary.ServiceCount>0 then WriteEmptyLine;
|
|
|
|
for i := 0 to (aLibrary.ArrayCount-1) do if (not aLibrary.Arrays[i].IsFromUsedRodl) then
|
|
Write(Format('%s = class;', [aLibrary.Arrays[i].Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
if aLibrary.ArrayCount>0 then WriteEmptyLine;
|
|
|
|
for i := 0 to (aLibrary.StructCount-1) do if (not aLibrary.Structs[i].IsFromUsedRodl) then
|
|
Write(Format('%s = class;', [aLibrary.Structs[i].Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
if aLibrary.StructCount>0 then WriteEmptyLine;
|
|
|
|
for i := 0 to (aLibrary.ExceptionCount-1) do if (not aLibrary.Exceptions[i].IsFromUsedRodl) then
|
|
Write(Format('%s = class;',[aLibrary.Exceptions[i].Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
if aLibrary.ExceptionCount>0 then WriteEmptyLine;
|
|
|
|
for i := 0 to (aLibrary.EventSinkCount-1) do if not aLibrary.EventSinks[i].IsFromUsedRodl then
|
|
Write(Format('I%s = interface;', [aLibrary.EventSinks[i].Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
if aLibrary.EventSinkCount>0 then WriteEmptyLine;
|
|
|
|
WriteEmptyLine;
|
|
|
|
if (EnumCount > 0) then begin
|
|
Write('{ Enumerateds }', PASCAL_INDENTATION_LEVEL_1);
|
|
for i := 0 to (EnumCount-1) do
|
|
if (not aLibrary.Enums[i].IsFromUsedRodl) then with Enums[i] do begin
|
|
WriteDocumentation(aLibrary.Enums[i]);
|
|
lPascalIndentationLevel := PASCAL_INDENTATION_LEVEL_1;
|
|
s := Info.Name+' = (';
|
|
l := Length(s);
|
|
for x := 0 to (Count-1) do begin
|
|
if PrefixEnumValues then
|
|
s2 := Info.Name+'_'+Items[x].Info.Name
|
|
else
|
|
s2 := Items[x].Info.Name;
|
|
s2 := s2 + ',';
|
|
Inc(l, Length(s2));
|
|
s := s + s2;
|
|
if (l>80) and (x <> Count-1) then begin
|
|
Write(s, lPascalIndentationLevel);
|
|
lPascalIndentationLevel := PASCAL_INDENTATION_LEVEL_3;
|
|
s := '';
|
|
l := 0;
|
|
end;
|
|
end;
|
|
System.Delete(s,Length(s),1);
|
|
s := s+');';
|
|
|
|
Write(s, lPascalIndentationLevel);
|
|
end;
|
|
WriteEmptyLine;
|
|
end;
|
|
|
|
end;
|
|
|
|
with aLibrary.CalcStructOrder() do begin
|
|
for i := 0 to (Count-1) do //if (not aLibrary.Services[i].IsFromUsedRodl) then
|
|
WriteTypeDeclaration(aLibrary, Objects[i] as TRODLStruct);
|
|
end;
|
|
//for i := 0 to (aLibrary.StructCount-1) do if (not aLibrary.Structs[i].IsFromUsedRodl) then
|
|
//WriteTypeDeclaration(aLibrary, aLibrary.Structs[i]);
|
|
|
|
for i := 0 to (aLibrary.ArrayCount-1) do if (not aLibrary.Arrays[i].IsFromUsedRodl) then
|
|
WriteTypeDeclaration(aLibrary, aLibrary.Arrays[i]);
|
|
|
|
if aLibrary.ExceptionCount > 0 then begin
|
|
Write('{ Exceptions }',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
with aLibrary.CalcExceptionOrder() do begin
|
|
for i := 0 to (Count-1) do begin
|
|
roexception := (Objects[i] as TRODLException);
|
|
GetInheritedExceptionFields(aLibrary, roexception, inheritedfields);
|
|
|
|
WriteDocumentation(roexception.Info);
|
|
if roexception.Ancestor <> '' then
|
|
Write(Format('%s = class(%s)',[roexception.Info.Name, roexception.Ancestor]),PASCAL_INDENTATION_LEVEL_1)
|
|
else
|
|
Write(Format('%s = class(EROException)',[roexception.Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
Write('private', PASCAL_INDENTATION_LEVEL_1);
|
|
for k := 0 to (roexception.Count-1) do begin
|
|
Write(Format('f%s: %s;', [roexception[k].Name, GetDataType(roexception[k].DataType)]), PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
|
|
Write('public', PASCAL_INDENTATION_LEVEL_1);
|
|
if (roexception.Count>0) then begin
|
|
s := 'constructor Create(anExceptionMessage : string; ';
|
|
for k := 0 to (inheritedfields.Count-1) do
|
|
s := s+Format('a%s: %s; ', [TRODLTypedEntity(inheritedfields[k]).Name, GetDataType(TRODLTypedEntity(inheritedfields[k]).DataType)]);
|
|
|
|
for k := 0 to (roexception.Count-1) do
|
|
s := s+Format('a%s: %s; ', [roexception[k].Name, GetDataType(roexception[k].DataType)]);
|
|
s := Copy(s,1,Length(s)-2)+');';
|
|
Write(AdjustParamList(s, PASCAL_INDENTATION_LEVEL_3), PASCAL_INDENTATION_LEVEL_2);
|
|
roexceptionEntityList:=roexception.CalcItemsMarshalingOrder(True);
|
|
if (roexception.Count>0) and (roexceptionEntityList.Count > 0) then begin
|
|
Write(' procedure ReadException(ASerializer: TObject); override;', PASCAL_INDENTATION_LEVEL_1);
|
|
Write(' procedure WriteException(ASerializer: TObject); override;', PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
roexceptionEntityList:=nil;
|
|
end;
|
|
|
|
Write('published', PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
for k := 0 to (roexception.Count-1) do begin
|
|
WriteDocumentation(roexception[k]);
|
|
Write(Format('property %s: %s read f%s write f%s;',
|
|
[roexception[k].Name, GetDataType(roexception[k].DataType),
|
|
roexception[k].Name, roexception[k].Name]),
|
|
PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
|
|
Write('end;', PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
end;
|
|
end;
|
|
|
|
{for i := 0 to (aLibrary.ExceptionCount-1) do if (not aLibrary.Exceptions[i].IsFromUsedRodl) then begin
|
|
WriteDocumentation(aLibrary.Exceptions[i].Info);
|
|
if aLibrary.Exceptions[i].Ancestor <> '' then
|
|
Write(Format('%s = class(%s);',[aLibrary.Exceptions[i].Info.Name, aLibrary.Exceptions[i].Ancestor]),PASCAL_INDENTATION_LEVEL_1)
|
|
else
|
|
Write(Format('%s = class(EROException);',[aLibrary.Exceptions[i].Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end; }
|
|
WriteEmptyLine;
|
|
end;
|
|
|
|
with aLibrary.CalcServiceOrder() do begin
|
|
for i := 0 to (Count-1) do //if (not aLibrary.Services[i].IsFromUsedRodl) then
|
|
WriteServiceDeclaration(Objects[i] as TRODLService);
|
|
end;
|
|
|
|
{-------- Events ----------}
|
|
//ToDo -omh: This should use a CalcServerEventsOrder method which is currently not present in uRODL.pas
|
|
with aLibrary do begin
|
|
for i := 0 to EventSinkCount-1 do begin
|
|
if aLibrary.EventSinks[i].IsFromUsedRodl then Continue;
|
|
|
|
WriteEventSinkDeclaration(aLibrary.EventSinks[i]);
|
|
end;
|
|
end;
|
|
{--------------------------}
|
|
|
|
{for i := 0 to (aLibrary.ServiceCount-1) do if (not aLibrary.Services[i].IsFromUsedRodl) then
|
|
WriteServiceDeclaration(aLibrary.Services[i]);}
|
|
|
|
//WriteEmptyLine;
|
|
|
|
Write('implementation');
|
|
WriteEmptyLine;
|
|
|
|
Write('uses');
|
|
Write('{vcl:} SysUtils,',PASCAL_INDENTATION_LEVEL_1);
|
|
Write('{RemObjects:} uROEventRepository, uROSerializer, uRORes;',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
WriteEmptyLine;
|
|
|
|
with aLibrary.CalcExceptionOrder() do begin
|
|
for i := 0 to (Count-1) do begin
|
|
roexception := (Objects[i] as TRODLException);
|
|
if (roexception.Count=0) then Continue;
|
|
GetInheritedExceptionFields(aLibrary, roexception, inheritedfields);
|
|
|
|
Write('{ '+roexception.Name+' }');
|
|
|
|
s := 'constructor '+roexception.Name+'.Create(anExceptionMessage : string; ';
|
|
for k := 0 to (inheritedfields.Count-1) do
|
|
s := s+Format('a%s: %s; ', [TRODLTypedEntity(inheritedfields[k]).Name, GetDataType(TRODLTypedEntity(inheritedfields[k]).DataType)]);
|
|
|
|
for k := 0 to (roexception.Count-1) do
|
|
s := s+Format('a%s: %s; ', [roexception[k].Name, GetDataType(roexception[k].DataType)]);
|
|
s := Copy(s,1,Length(s)-2)+');';
|
|
Write(AdjustParamList(s, 1));
|
|
|
|
Write('begin');
|
|
s := ' inherited Create(anExceptionMessage';
|
|
for k := 0 to (inheritedfields.Count-1) do
|
|
s := s+Format(', a%s', [TRODLTypedEntity(inheritedfields[k]).Name]);
|
|
s := s+');';
|
|
Write(AdjustParamList(s, 10));
|
|
|
|
WriteEmptyLine;
|
|
|
|
for k := 0 to (roexception.Count-1) do begin
|
|
Write(Format(' f%s := a%s;', [roexception[k].Name, roexception[k].Name]));
|
|
end;
|
|
|
|
Write('end;');
|
|
|
|
roexceptionEntityList:=roexception.CalcItemsMarshalingOrder(True);
|
|
if (roexception.Count>0) and (roexceptionEntityList.Count > 0) then begin
|
|
WriteEmptyLine;
|
|
Write('procedure '+roexception.Name+'.ReadException(ASerializer: TObject);');
|
|
if roexceptionEntityList.Count > 0 then Write('var');
|
|
For k:=0 to roexceptionEntityList.Count - 1 do
|
|
with TRODLTypedEntity(roexceptionEntityList.Objects[k]) do
|
|
Write(Format(' l_%s: %s;',[Name, GetDataType(DataType)]));
|
|
Write('begin');
|
|
Write(' if TROSerializer(ASerializer).RecordStrictOrder then begin');
|
|
if roexception.Count <> roexceptionEntityList.Count then
|
|
Write(' inherited;');
|
|
for k := 0 to (roexception.Count-1) do begin
|
|
roexceptionEntity:= roexception[k];
|
|
Write(Format(' l_%s := %0:s;',[roexceptionEntity.Name]));
|
|
case StrToDataType(roexceptionEntity.DataType) of
|
|
rtInteger: Write(Format(' TROSerializer(ASerializer).ReadInteger(''%s'', otSLong, l_%0:s);',[roexceptionEntity.Name]));
|
|
rtDateTime: Write(Format(' TROSerializer(ASerializer).ReadDateTime(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtDouble: Write(Format(' TROSerializer(ASerializer).ReadDouble(''%s'', ftDouble, l_%0:s);',[roexceptionEntity.Name]));
|
|
rtCurrency: Write(Format(' TROSerializer(ASerializer).ReadDouble(''%s'', ftCurr, l_%0:s);',[roexceptionEntity.Name]));
|
|
rtWidestring: Write(Format(' TROSerializer(ASerializer).ReadWideString(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtString: Write(Format(' TROSerializer(ASerializer).ReadUTF8String(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtInt64: Write(Format(' TROSerializer(ASerializer).ReadInt64(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtBoolean: Write(Format(' TROSerializer(ASerializer).ReadEnumerated(''%s'',TypeInfo(boolean), l_%0:s);',[roexceptionEntity.Name]));
|
|
rtVariant: Write(Format(' TROSerializer(ASerializer).ReadVariant(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtXML: Write(Format(' TROSerializer(ASerializer).ReadXML(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtGuid: Write(Format(' TROSerializer(ASerializer).ReadGuid(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtDecimal: Write(Format(' TROSerializer(ASerializer).ReadDecimal(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtBinary: Write(Format(' TROSerializer(ASerializer).ReadBinary(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtUserDefined:
|
|
if aLibrary.FindArray(roexceptionEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).ReadArray(''%s'', %s, l_%0:s);',[roexceptionEntity.Name,GetDataType(roexceptionEntity.DataType)]))
|
|
else if aLibrary.FindEnum(roexceptionEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).ReadEnumerated(''%s'',TypeInfo(%s), l_%0:s);',[roexceptionEntity.Name,GetDataType(roexceptionEntity.DataType)]))
|
|
else
|
|
Write(Format(' TROSerializer(ASerializer).ReadStruct(''%s'', %s, l_%0:s);',[roexceptionEntity.Name,GetDataType(roexceptionEntity.DataType)]));
|
|
end;
|
|
if (StrToDataType(roexceptionEntity.DataType) in [rtBinary, rtUserDefined]) and (aLibrary.FindEnum(roexceptionEntity.DataType) = nil) then
|
|
Write(Format(' if %s <> l_%0:s then %0:s.Free;',[roexceptionEntity.Name]));
|
|
Write(Format(' %s := l_%0:s;',[roexceptionEntity.Name]));
|
|
end;
|
|
Write(' end');
|
|
Write(' else begin');
|
|
for k := 0 to (roexceptionEntityList.Count-1) do begin
|
|
roexceptionEntity:= TRODLTypedEntity(roexceptionEntityList.Objects[k]);
|
|
Write(Format(' l_%s := %0:s;',[roexceptionEntity.Name]));
|
|
case StrToDataType(roexceptionEntity.DataType) of
|
|
rtInteger: Write(Format(' TROSerializer(ASerializer).ReadInteger(''%s'', otSLong, l_%0:s);',[roexceptionEntity.Name]));
|
|
rtDateTime: Write(Format(' TROSerializer(ASerializer).ReadDateTime(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtDouble: Write(Format(' TROSerializer(ASerializer).ReadDouble(''%s'', ftDouble, l_%0:s);',[roexceptionEntity.Name]));
|
|
rtCurrency: Write(Format(' TROSerializer(ASerializer).ReadDouble(''%s'', ftCurr, l_%0:s);',[roexceptionEntity.Name]));
|
|
rtWidestring: Write(Format(' TROSerializer(ASerializer).ReadWideString(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtString: Write(Format(' TROSerializer(ASerializer).ReadUTF8String(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtInt64: Write(Format(' TROSerializer(ASerializer).ReadInt64(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtBoolean: Write(Format(' TROSerializer(ASerializer).ReadEnumerated(''%s'',TypeInfo(boolean), l_%0:s);',[roexceptionEntity.Name]));
|
|
rtVariant: Write(Format(' TROSerializer(ASerializer).ReadVariant(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtXML: Write(Format(' TROSerializer(ASerializer).ReadXML(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtGuid: Write(Format(' TROSerializer(ASerializer).ReadGuid(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtDecimal: Write(Format(' TROSerializer(ASerializer).ReadDecimal(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtBinary: Write(Format(' TROSerializer(ASerializer).ReadBinary(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtUserDefined:
|
|
if aLibrary.FindArray(roexceptionEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).ReadArray(''%s'', %s, l_%0:s);',[roexceptionEntity.Name,GetDataType(roexceptionEntity.DataType)]))
|
|
else if aLibrary.FindEnum(roexceptionEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).ReadEnumerated(''%s'',TypeInfo(%s), l_%0:s);',[roexceptionEntity.Name,GetDataType(roexceptionEntity.DataType)]))
|
|
else
|
|
Write(Format(' TROSerializer(ASerializer).ReadStruct(''%s'', %s, l_%0:s);',[roexceptionEntity.Name,GetDataType(roexceptionEntity.DataType)]));
|
|
end;
|
|
if (StrToDataType(roexceptionEntity.DataType) in [rtBinary, rtUserDefined]) and (aLibrary.FindEnum(roexceptionEntity.DataType) = nil) then
|
|
Write(Format(' if %s <> l_%0:s then %0:s.Free;',[roexceptionEntity.Name]));
|
|
Write(Format(' %s := l_%0:s;',[roexceptionEntity.Name]));
|
|
end;
|
|
Write(' end;');
|
|
Write('end;');
|
|
|
|
|
|
WriteEmptyLine;
|
|
Write('procedure '+roexception.Name+'.WriteException(ASerializer: TObject);');
|
|
if roexceptionEntityList.Count > 0 then Write('var');
|
|
For k:=0 to roexceptionEntityList.Count - 1 do
|
|
with TRODLTypedEntity(roexceptionEntityList.Objects[k]) do
|
|
Write(Format(' l_%s: %s;',[Name, GetDataType(DataType)]));
|
|
Write('begin');
|
|
Write(' if TROSerializer(ASerializer).RecordStrictOrder then begin');
|
|
if roexception.Count <> roexceptionEntityList.Count then
|
|
Write(' inherited;');
|
|
for k := 0 to (roexception.Count-1) do begin
|
|
roexceptionEntity:= roexception[k];
|
|
Write(Format(' l_%s := %0:s;',[roexceptionEntity.Name]));
|
|
case StrToDataType(roexceptionEntity.DataType) of
|
|
rtInteger: Write(Format(' TROSerializer(ASerializer).WriteInteger(''%s'', otSLong, l_%0:s);',[roexceptionEntity.Name]));
|
|
rtDateTime: Write(Format(' TROSerializer(ASerializer).WriteDateTime(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtDouble: Write(Format(' TROSerializer(ASerializer).WriteDouble(''%s'', ftDouble, l_%0:s);',[roexceptionEntity.Name]));
|
|
rtCurrency: Write(Format(' TROSerializer(ASerializer).WriteDouble(''%s'', ftCurr, l_%0:s);',[roexceptionEntity.Name]));
|
|
rtWidestring: Write(Format(' TROSerializer(ASerializer).WriteWideString(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtString: Write(Format(' TROSerializer(ASerializer).WriteUTF8String(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtInt64: Write(Format(' TROSerializer(ASerializer).WriteInt64(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtBoolean: Write(Format(' TROSerializer(ASerializer).WriteEnumerated(''%s'',TypeInfo(boolean), l_%0:s);',[roexceptionEntity.Name]));
|
|
rtVariant: Write(Format(' TROSerializer(ASerializer).WriteVariant(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtXML: Write(Format(' TROSerializer(ASerializer).WriteXML(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtGuid: Write(Format(' TROSerializer(ASerializer).WriteGuid(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtDecimal: Write(Format(' TROSerializer(ASerializer).WriteDecimal(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtBinary: Write(Format(' TROSerializer(ASerializer).WriteBinary(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtUserDefined:
|
|
if aLibrary.FindArray(roexceptionEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).WriteArray(''%s'', l_%0:s);',[roexceptionEntity.Name]))
|
|
else if aLibrary.FindEnum(roexceptionEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).WriteEnumerated(''%s'',TypeInfo(%s), l_%0:s);',[roexceptionEntity.Name,roexceptionEntity.DataType]))
|
|
else
|
|
Write(Format(' TROSerializer(ASerializer).WriteStruct(''%s'', l_%0:s);',[roexceptionEntity.Name]))
|
|
end;
|
|
end;
|
|
Write(' end');
|
|
Write(' else begin');
|
|
for k := 0 to (roexceptionEntityList.Count-1) do begin
|
|
roexceptionEntity:= TRODLTypedEntity(roexceptionEntityList.Objects[k]);
|
|
Write(Format(' l_%s := %0:s;',[roexceptionEntity.Name]));
|
|
case StrToDataType(roexceptionEntity.DataType) of
|
|
rtInteger: Write(Format(' TROSerializer(ASerializer).WriteInteger(''%s'', otSLong, l_%0:s);',[roexceptionEntity.Name]));
|
|
rtDateTime: Write(Format(' TROSerializer(ASerializer).WriteDateTime(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtDouble: Write(Format(' TROSerializer(ASerializer).WriteDouble(''%s'', ftDouble, l_%0:s);',[roexceptionEntity.Name]));
|
|
rtCurrency: Write(Format(' TROSerializer(ASerializer).WriteDouble(''%s'', ftCurr, l_%0:s);',[roexceptionEntity.Name]));
|
|
rtWidestring: Write(Format(' TROSerializer(ASerializer).WriteWideString(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtString: Write(Format(' TROSerializer(ASerializer).WriteUTF8String(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtInt64: Write(Format(' TROSerializer(ASerializer).WriteInt64(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtBoolean: Write(Format(' TROSerializer(ASerializer).WriteEnumerated(''%s'',TypeInfo(boolean), l_%0:s);',[roexceptionEntity.Name]));
|
|
rtVariant: Write(Format(' TROSerializer(ASerializer).WriteVariant(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtXML: Write(Format(' TROSerializer(ASerializer).WriteXML(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtGuid: Write(Format(' TROSerializer(ASerializer).WriteGuid(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtDecimal: Write(Format(' TROSerializer(ASerializer).WriteDecimal(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtBinary: Write(Format(' TROSerializer(ASerializer).WriteBinary(''%s'', l_%0:s);',[roexceptionEntity.Name]));
|
|
rtUserDefined:
|
|
if aLibrary.FindArray(roexceptionEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).WriteArray(''%s'', l_%0:s);',[roexceptionEntity.Name]))
|
|
else if aLibrary.FindEnum(roexceptionEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).WriteEnumerated(''%s'',TypeInfo(%s), l_%0:s);',[roexceptionEntity.Name,roexceptionEntity.DataType]))
|
|
else
|
|
Write(Format(' TROSerializer(ASerializer).WriteStruct(''%s'', l_%0:s);',[roexceptionEntity.Name]))
|
|
end;
|
|
end;
|
|
Write(' end;');
|
|
Write('end;');
|
|
end;
|
|
roexceptionEntityList:=nil;
|
|
WriteEmptyLine;
|
|
end;
|
|
end;
|
|
|
|
for i := 0 to (aLibrary.ArrayCount-1) do if (not aLibrary.Arrays[i].IsFromUsedRodl) then
|
|
WriteArraySerializer(aLibrary, aLibrary.Arrays[i]);
|
|
|
|
for i := 0 to (aLibrary.StructCount-1) do if (not aLibrary.Structs[i].IsFromUsedRodl) then
|
|
WriteStructPropMethods(aLibrary, aLibrary.Structs[i]);
|
|
|
|
for i := 0 to (aLibrary.ServiceCount-1) do if (not aLibrary.Services[i].IsFromUsedRodl) then
|
|
WriteCoClass(aLibrary, aLibrary.Services[i]);
|
|
|
|
for i := 0 to (aLibrary.EventSinkCount-1) do if (not aLibrary.EventSinks[i].IsFromUsedRodl) then
|
|
WriteEventSink(aLibrary, aLibrary.EventSinks[i]);
|
|
|
|
Write('initialization');
|
|
for i := 0 to (aLibrary.Count-1) do
|
|
if ((aLibrary.Items[i] is TRODLArray) or (aLibrary.Items[i] is TRODLStruct)) and
|
|
(not aLibrary.Items[i].IsFromUsedRodl) then
|
|
Write(' RegisterROClass('+aLibrary.Items[i].Info.Name+');');
|
|
|
|
for i := 0 to (aLibrary.ExceptionCount-1) do if (not aLibrary.Exceptions[i].IsFromUsedRodl) then begin
|
|
Write(Format('RegisterExceptionClass(%s);',[aLibrary.Exceptions[i].Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
|
|
for i := 0 to (aLibrary.Count-1) do
|
|
if (aLibrary.Items[i] is TRODLService) and not aLibrary.Items[i].IsFromUsedRodl then begin
|
|
Write(' RegisterProxyClass(I'+aLibrary.Items[i].Info.Name+'_IID, T'+aLibrary.Items[i].Info.Name+'_Proxy);');
|
|
end;
|
|
|
|
WriteEmptyLine;
|
|
with aLibrary do
|
|
for i := 0 to EventSinkCount-1 do
|
|
if (not EventSinks[i].IsFromUsedRodl) then begin
|
|
Write(Format(' RegisterEventWriterClass(I%s_Writer, T%s_Writer);', [EventSinks[i].Info.Name, EventSinks[i].Info.Name]));
|
|
Write(Format(' RegisterEventInvokerClass(EID_%s, T%s_Invoker);', [EventSinks[i].Info.Name, EventSinks[i].Info.Name]));
|
|
end;
|
|
|
|
Write('');
|
|
Write('finalization');
|
|
for i := 0 to (aLibrary.Count-1) do
|
|
if ((aLibrary.Items[i] is TRODLArray) or (aLibrary.Items[i] is TRODLStruct)) and
|
|
(not aLibrary.Items[i].IsFromUsedRodl) then
|
|
Write(' UnregisterROClass('+aLibrary.Items[i].Info.Name+');');
|
|
|
|
for i := 0 to (aLibrary.ExceptionCount-1) do if (not aLibrary.Exceptions[i].IsFromUsedRodl) then begin
|
|
Write(Format('UnregisterExceptionClass(%s);',[aLibrary.Exceptions[i].Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
|
|
for i := 0 to (aLibrary.Count-1) do
|
|
if (aLibrary.Items[i] is TRODLService) and not aLibrary.Items[i].IsFromUsedRodl then begin
|
|
Write(' UnregisterProxyClass(I'+aLibrary.Items[i].Info.Name+'_IID);');
|
|
end;
|
|
|
|
WriteEmptyLine;
|
|
with aLibrary do
|
|
for i := 0 to EventSinkCount-1 do
|
|
if (not EventSinks[i].IsFromUsedRodl) then begin
|
|
Write(Format(' UnregisterEventWriterClass(I%s_Writer);', [EventSinks[i].Info.Name]));
|
|
Write(Format(' UnregisterEventInvokerClass(EID_%s);', [EventSinks[i].Info.Name]));
|
|
end;
|
|
|
|
//WriteEmptyLine;
|
|
|
|
{Write('finalization');
|
|
for i := 0 to (aLibrary.Count-1) do
|
|
if (aLibrary.Items[i] is TRODLArray) or (aLibrary.Items[i] is TRODLStruct)
|
|
then Write(' UnRegisterClass('+aLibrary.Items[i].Info.Name+');');
|
|
|
|
WriteEmptyLine;}
|
|
|
|
Write('end.');
|
|
|
|
finally
|
|
inheritedfields.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLToIntf.WriteServiceConsts(aService : TRODLService);
|
|
begin
|
|
with aService.Info do
|
|
// Writes additional SOAP information
|
|
if IsSOAPService(aService) then begin
|
|
Write(Format(' %s_EndPointURI = ''%s'';', [Name, Attributes.Values['Location']]));
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLToIntf.WriteDocumentation(aInfo:TRODLEntity);
|
|
var lDocumentation:string;
|
|
begin
|
|
if aInfo.Documentation <> '' then begin
|
|
lDocumentation := aInfo.Documentation;
|
|
ReplaceChar(lDocumentation,['}','{', #13, #10],' ');
|
|
|
|
WriteEmptyLine;
|
|
Write('{ Description:',PASCAL_INDENTATION_LEVEL_1);
|
|
Write(' '+lDocumentation+' }',PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLToIntf.WriteOperationDocumentation(anOperation:TRODLOperation; IndentationLevel : integer);
|
|
var lDocumentation:string;
|
|
i : integer;
|
|
begin
|
|
if anOperation.Documentation <> '' then begin
|
|
lDocumentation := anOperation.Documentation;
|
|
ReplaceChar(lDocumentation,['}','{', #13, #10],' ');
|
|
|
|
WriteEmptyLine;
|
|
Write('{ Description:',IndentationLevel);
|
|
Write(' '+lDocumentation,IndentationLevel);
|
|
if (anOperation.Result<>NIL) then begin
|
|
Write('');
|
|
Write(' Return Type: '+GetDataType(anOperation.Result.DataType),IndentationLevel);
|
|
end;
|
|
Write(' Params',IndentationLevel);
|
|
for i := 0 to (anOperation.Count-1) do begin
|
|
Write(' '+IntToStr(i+1)+') '+anOperation[i].Name+' ('+GetDataType(anOperation[i].DataType)+') : '+anOperation[i].Documentation,IndentationLevel);
|
|
end;
|
|
|
|
Write('}',IndentationLevel);
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLToIntf.WriteServiceDeclaration(aService : TRODLService);
|
|
var i : integer;
|
|
begin
|
|
if not aService.IsFromUsedRodl then with aService.Default do begin
|
|
Write(Format('{ I%s }', [aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
WriteDocumentation(aService);
|
|
|
|
if aService.Ancestor <> '' then begin
|
|
Write(Format('I%s = interface(I%s)', [aService.Info.Name,aService.Ancestor]), PASCAL_INDENTATION_LEVEL_1);
|
|
end
|
|
else begin
|
|
Write(Format('I%s = interface', [aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
Write(Format('[''%s'']', [GUIDToString(Info.UID)]), PASCAL_INDENTATION_LEVEL_2);
|
|
|
|
for i := 0 to (Count-1) do begin
|
|
WriteOperationDocumentation(Items[i], PASCAL_INDENTATION_LEVEL_2);
|
|
Write(GetOperationDefinition(Items[i]), PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
|
|
Write('end;', PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
|
|
Write(Format('{ Co%s }', [aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
Write(Format('Co%s = class', [aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
Write(Format('class function Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): I%s;',
|
|
[aService.Info.Name]), PASCAL_INDENTATION_LEVEL_2);
|
|
Write('end;', PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
|
|
Write(Format('{ T%s_Proxy }', [aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
if aService.Ancestor <> '' then begin
|
|
Write(Format('T%s_Proxy = class(T%s_Proxy, I%s)', [aService.Info.Name, aService.Ancestor, aService.Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end
|
|
else begin
|
|
Write(Format('T%s_Proxy = class(TROProxy, I%s)', [aService.Info.Name, aService.Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
//Write('private',PASCAL_INDENTATION_LEVEL_1);
|
|
Write('protected',PASCAL_INDENTATION_LEVEL_1);
|
|
//Write(' // Internal',PASCAL_INDENTATION_LEVEL_1);
|
|
Write(' function __GetInterfaceName:string; override;',PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
//Write(Format(' // %s', [aService.Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
for i := 0 to (Count-1) do
|
|
Write(GetOperationDefinition(Items[i]), PASCAL_INDENTATION_LEVEL_2);
|
|
Write('end;',PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLToIntf.WriteEventSinkDeclaration(aEventSink : TRODLEventSink);
|
|
var i : integer;
|
|
begin
|
|
if not aEventSink.IsFromUsedRodl then with aEventSink.Default do begin
|
|
{ Client events }
|
|
Write(Format('{ I%s }', [aEventSink.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
WriteDocumentation(aEventSink);
|
|
if aEventSink.Ancestor <> '' then begin
|
|
Write(Format('I%s = interface(I%s)', [aEventSink.Info.Name,aEventSink.Ancestor]), PASCAL_INDENTATION_LEVEL_1);
|
|
end
|
|
else begin
|
|
Write(Format('I%s = interface', [aEventSink.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
Write(Format('[''%s'']', [GUIDToString(Info.UID)]), PASCAL_INDENTATION_LEVEL_2);
|
|
|
|
for i := 0 to (Count-1) do begin
|
|
WriteOperationDocumentation(Items[i], PASCAL_INDENTATION_LEVEL_2);
|
|
Write(GetOperationDefinition(Items[i]), PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
|
|
Write('end;', PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
|
|
{ Events writer }
|
|
Write(Format('{ I%s_Writer }', [aEventSink.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
WriteDocumentation(aEventSink);
|
|
if aEventSink.Ancestor <> '' then begin
|
|
Write(Format('I%s_Writer = interface(I%s_Writer)', [aEventSink.Info.Name,aEventSink.Ancestor]), PASCAL_INDENTATION_LEVEL_1);
|
|
end
|
|
else begin
|
|
Write(Format('I%s_Writer = interface(IROEventWriter)', [aEventSink.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
Write(Format('[''%s'']', [GUIDToString(Info.UID){GUIDToString(NewUID)}]), PASCAL_INDENTATION_LEVEL_2);
|
|
|
|
for i := 0 to (Count-1) do begin
|
|
Write(GetOperationDefinition(Items[i], '', '', TRUE), PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
|
|
Write('end;', PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLToIntf.WriteEventSink(aLibrary : TRODLLibrary; aEventSink : TRODLEventSink);
|
|
var i, x : integer;
|
|
parline, typname : string;
|
|
par : TRODLOperationParam;
|
|
begin
|
|
if not aEventSink.IsFromUsedRodl then with aEventSink.Default do begin
|
|
{ -------------------------- EVENT WRITER -------------------------- }
|
|
Write('type');
|
|
|
|
{ Event writer class }
|
|
Write(Format('{ T%s_Writer }', [aEventSink.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
if aEventSink.Ancestor <> '' then begin
|
|
Write(Format('T%s_Writer = class(T%s_Writer, I%s_Writer)', [aEventSink.Info.Name, aEventSink.Ancestor, aEventSink.Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end
|
|
else begin
|
|
Write(Format('T%s_Writer = class(TROEventWriter, I%s_Writer)', [aEventSink.Info.Name, aEventSink.Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
//Write('private',PASCAL_INDENTATION_LEVEL_1);
|
|
Write('protected',PASCAL_INDENTATION_LEVEL_1);
|
|
//Write(' // Internal',PASCAL_INDENTATION_LEVEL_1);
|
|
//Write(Format(' // %s', [aEventSink.Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
for i := 0 to (Count-1) do
|
|
Write(GetOperationDefinition(Items[i], '', '', TRUE), PASCAL_INDENTATION_LEVEL_2);
|
|
Write('end;',PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
|
|
{ Actual methods }
|
|
for i := 0 to (Count-1) do begin
|
|
Write(GetOperationDefinition(Items[i], 'T'+aEventSink.Info.Name+'_Writer', '', TRUE));
|
|
Write('var __eventdata : Binary;');
|
|
|
|
Write('begin');
|
|
Write(' __eventdata := Binary.Create;');
|
|
Write(' try');
|
|
Write(Format(' __Message.InitializeEventMessage(NIL, ''%s'', EID_%s, ''%s'');', [aLibrary.Name, aEventSink.Info.Name, Items[i].Info.Name]));
|
|
|
|
{ Write parameters }
|
|
for x := 0 to (Items[i].Count-1) do begin
|
|
par := Items[i].Items[x];
|
|
typname := GetDataType(par.DataType);
|
|
|
|
{ if IsUserDefinedType(typname,aLibrary) then begin
|
|
typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
|
|
end;}
|
|
Write(Format(' __Message.Write(''%s'', TypeInfo(%s), %s, []);', [par.Name, typname, par.Name]));
|
|
end;
|
|
|
|
Write(' __Message.Finalize;');
|
|
WriteEmptyLine;
|
|
Write(' __Message.WriteToStream(__eventdata);');
|
|
WriteEmptyLine;
|
|
Write(' Repository.StoreEventData(__Sender, __eventdata, ExcludeSender, ExcludeSessionList, SessionList.CommaText);');
|
|
Write(' finally');
|
|
Write(' __eventdata.Free;');
|
|
Write(' end;');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
end;
|
|
|
|
{ -------------------------- INVOKER -------------------------- }
|
|
Write('type');
|
|
|
|
{ Event invoker class }
|
|
Write('{$M+}', PASCAL_INDENTATION_LEVEL_1);
|
|
Write(Format('{ T%s_Invoker }', [aEventSink.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
if aEventSink.Ancestor <> '' then begin
|
|
Write(Format('T%s_Invoker = class(T%s_Writer, I%s)', [aEventSink.Info.Name, aEventSink.Ancestor, aEventSink.Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end
|
|
else begin
|
|
Write(Format('T%s_Invoker = class(TROEventInvoker)', [aEventSink.Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
Write('published',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
for i := 0 to (Count-1) do
|
|
Write('procedure Invoke_'+Items[i].Info.Name+'(__EventReceiver : TROEventReceiver; const __Message : IROMessage; const __Target : IUnknown);', PASCAL_INDENTATION_LEVEL_2);
|
|
|
|
|
|
Write('end;',PASCAL_INDENTATION_LEVEL_1);
|
|
Write('{$M-}', PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
|
|
{ Actual methods }
|
|
|
|
for i := 0 to (Count-1) do begin
|
|
Write(Format('procedure T%s_Invoker.Invoke_%s(__EventReceiver : TROEventReceiver; const __Message : IROMessage; const __Target : IUnknown);',
|
|
[aEventSink.Info.Name, Items[i].Info.Name]));
|
|
//Write(GetOperationDefinition(Items[i], 'T'+aEventSink.Info.Name+'_Invoker', '', FALSE));
|
|
|
|
{ Write local variables }
|
|
Write('var');
|
|
Write('__lObjectDisposer: TROObjectDisposer;');
|
|
if (Items[i].Count>0) then begin
|
|
for x := 0 to (Items[i].Count-1) do begin
|
|
par := Items[i].Items[x];
|
|
typname := GetDataType(par.DataType);
|
|
|
|
{ if IsUserDefinedType(typname,aLibrary) then begin
|
|
typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
|
|
end;}
|
|
Write(Format(' %s: %s;', [par.Name, typname]));
|
|
end;
|
|
end;
|
|
|
|
Write('begin');
|
|
|
|
for x := 0 to Items[i].Count-1 do begin
|
|
par := Items[i].Items[x];
|
|
typname := GetDataType(par.DataType);
|
|
|
|
if not IsSimpleType(typname, aLibrary)
|
|
then Write(Format(' %s := NIL;', [par.Name]));
|
|
end;
|
|
if Items[i].Count>0 then WriteEmptyLine;
|
|
|
|
Write('try', PASCAL_INDENTATION_LEVEL_1);
|
|
parline := '';
|
|
{ Readers local variables values }
|
|
if (Items[i].Count>0) then begin
|
|
for x := 0 to (Items[i].Count-1) do begin
|
|
par := Items[i].Items[x];
|
|
parline := parline+par.Name+', ';
|
|
|
|
typname := GetDataType(par.DataType);
|
|
|
|
{ if IsUserDefinedType(typname,aLibrary) then begin
|
|
typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
|
|
end;}
|
|
|
|
Write(Format('__Message.Read(''%s'', TypeInfo(%s), %s, []);', [par.Name, typname, par.Name]), PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
end;
|
|
|
|
WriteEmptyLine;
|
|
parline := Copy(parline, 1, Length(parline)-2);
|
|
Write(Format('(__Target as I%s).%s(%s);',
|
|
[aEventSink.Info.Name, Items[i].Info.Name, parline]), PASCAL_INDENTATION_LEVEL_2);
|
|
WriteEmptyLine;
|
|
|
|
Write('finally', PASCAL_INDENTATION_LEVEL_1);
|
|
Write('__lObjectDisposer:= TROObjectDisposer.Create(__EventReceiver);', PASCAL_INDENTATION_LEVEL_2);
|
|
Write('try', PASCAL_INDENTATION_LEVEL_2);
|
|
for x := 0 to Items[i].Count-1 do begin
|
|
par := Items[i].Items[x];
|
|
typname := GetDataType(par.DataType);
|
|
|
|
if not IsSimpleType(typname, aLibrary)
|
|
then Write('__lObjectDisposer.Add('+par.Name+');', PASCAL_INDENTATION_LEVEL_3);
|
|
end;
|
|
Write('finally', PASCAL_INDENTATION_LEVEL_2);
|
|
Write('__lObjectDisposer.Free();', PASCAL_INDENTATION_LEVEL_3);
|
|
Write('end', PASCAL_INDENTATION_LEVEL_2);
|
|
Write('end', PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TRODLToIntf.GetTargetFileName(const aLibrary: TRODLLibrary;
|
|
const aTargetEntity: string): string;
|
|
begin
|
|
try
|
|
result := aLibrary.Info.Name+'_Intf.pas'
|
|
except
|
|
result := 'Unknown.pas';
|
|
end;
|
|
end;
|
|
|
|
const
|
|
InnerIndent = 4;
|
|
|
|
procedure TRODLToIntf.WriteCoClass(aLibrary: TRODLLibrary; aService: TRODLService);
|
|
var i, p : integer;
|
|
sa : string;
|
|
// soapsvc : boolean;
|
|
typname : string;
|
|
// urn : string;
|
|
begin
|
|
with aService.Default do begin
|
|
// soapsvc := IsSOAPService(aService);
|
|
|
|
Write('{ Co'+aService.Info.Name+' }');
|
|
WriteEmptyLine;
|
|
|
|
Write(Format('class function Co%s.Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): I%s;',
|
|
[aService.Info.Name, aService.Info.Name]));
|
|
Write('begin');
|
|
Write(Format(' result := T%s_Proxy.Create(aMessage, aTransportChannel);', [aService.Info.Name]));
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
if Count > 0 then begin
|
|
Write(Format('{ T%s_Proxy }', [aService.Info.Name]));
|
|
WriteEmptyLine;
|
|
end;
|
|
|
|
Write(Format('function T%s_Proxy.__GetInterfaceName:string;',[aService.Info.Name]));
|
|
Write('begin');
|
|
Write(Format(' result := ''%s'';',[aService.Info.Name]));
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
for i := 0 to (Count-1) do begin
|
|
Write(GetOperationDefinition(Items[i], Format('T%s_Proxy', [aService.Info.Name])));
|
|
// Write('var');
|
|
// Write(' __request, __response : TMemoryStream;');
|
|
//if soapsvc then write('var');
|
|
//if soapsvc then Write(' __http : IROHTTPTransport;');
|
|
//if soapsvc then Write(' __TargetUrlWasSet : boolean;');
|
|
Write('begin');
|
|
//if soapsvc then Write('__TargetUrlWasSet := false;',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
sa := GetAttributes(Items[i].Info.Attributes, aService.Info.Attributes, aLibrary.Info.Attributes, InnerIndent);
|
|
if sa <> '' then
|
|
Write('__Message.SetAttributes(__TransportChannel, '+sa+');', InnerIndent);
|
|
write('try', PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
with Items[i] do begin
|
|
for p := 0 to (Count-1) do
|
|
if (Items[p].Flag = fOut) and IsImplementedAsClass(Items[p].DataType, aLibrary) then
|
|
Write(Format('%s := nil;', [Items[p].Name]),PASCAL_INDENTATION_LEVEL_2);
|
|
if Assigned(Result) and IsImplementedAsClass(Result.DataType, aLibrary) then
|
|
Write('result := nil;', PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
|
|
// Write('__request := TMemoryStream.Create;',PASCAL_INDENTATION_LEVEL_1);
|
|
// Write('__response := TMemoryStream.Create;',PASCAL_INDENTATION_LEVEL_1);
|
|
// WriteEmptyLine;
|
|
// Write('try',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
(* if soapsvc then begin
|
|
urn := Items[i].Info.Attributes.Values['Action'];
|
|
if (urn='') then urn := Items[0].Info.Attributes.Values['InputNamespace']; // Apache ones...
|
|
|
|
if Items[i].Info.Attributes.Values['InputMessageName'] <> '' then
|
|
Write(Format('__Message.InitializeRequestMessage(__TransportChannel, ''%s'', TargetNamespace, ''%s'');', [aLibrary.Info.Name, Items[i].Info.Attributes.Values['InputMessageName']]),InnerIndent)
|
|
else
|
|
Write(Format('__Message.InitializeRequestMessage(__TransportChannel, ''%s'', TargetNamespace, ''%s'');', [aLibrary.Info.Name, Items[i].Info.Name]),InnerIndent);
|
|
|
|
WriteEmptyLine;
|
|
Write('if Supports(__TransportChannel, IROHTTPTransport, __http) then begin',InnerIndent);
|
|
Write(Format(' __http.Headers[''SOAPAction''] := ''"%s"'';', [Items[i].Info.Attributes.Values['Action']]),InnerIndent);
|
|
Write(' __TargetUrlWasSet := (__http.TargetURL='''');',InnerIndent);
|
|
Write(Format(' if __TargetUrlWasSet then __http.TargetURL := %s_EndPointURI;', [aService.Info.Name]),InnerIndent);
|
|
Write('end;',InnerIndent);
|
|
WriteEmptyLine;
|
|
end
|
|
else begin
|
|
//Write(Format('__Message.Initialize(__TransportChannel, ''%s'', ''%s'', ''%s'');', [aLibrary.Info.Name, aService.Info.Name, Items[i].Info.Name]),InnerIndent);
|
|
if Items[i].Info.Attributes.Values['InputMessageName'] <> '' then
|
|
Write(Format('__Message.InitializeRequestMessage(__TransportChannel, ''%s'', __InterfaceName, ''%s'');', [aLibrary.Info.Name, Items[i].Info.Attributes.Values['InputMessageName']]),InnerIndent)
|
|
else*)
|
|
Write(Format('__Message.InitializeRequestMessage(__TransportChannel, ''%s'', __InterfaceName, ''%s'');', [aLibrary.Info.Name, Items[i].Info.Name]),InnerIndent);
|
|
(* end;*)
|
|
|
|
with Items[i] do begin
|
|
for p := 0 to (Count-1) do
|
|
if IsInputFlag(Items[p].Flag) then begin
|
|
if (StrToDataType(Items[p].DataType)=rtDateTime)
|
|
then sa := '[paIsDateTime]'
|
|
else sa := '[]';
|
|
|
|
|
|
typname := GetDataType(Items[p].DataType);
|
|
if IsUserDefinedType(typname,aLibrary) then begin
|
|
typname := GetFullyQualifiedTypeName(typname,aLibrary,fUnitName);
|
|
end;
|
|
|
|
Write(Format('__Message.Write(''%s'', TypeInfo(%s), %s, %s);',
|
|
[Items[p].Name, typname, Items[p].Name, sa]),InnerIndent);
|
|
end;
|
|
end;
|
|
Write('__Message.Finalize;',InnerIndent);
|
|
WriteEmptyLine;
|
|
|
|
// Write('__Message.WriteToStream(__request);',InnerIndent);
|
|
// Write('__TransportChannel.Dispatch(__request, __response);',InnerIndent);
|
|
// Write('__Message.ReadFromStream(__response);',InnerIndent);
|
|
Write('__TransportChannel.Dispatch(__Message);',InnerIndent);
|
|
WriteEmptyLine;
|
|
|
|
//Write(Format('Message.Initialize(''I%s'', ''%s'');', [aService.Name, Items[i].Name]),InnerIndent);
|
|
with Items[i] do begin
|
|
|
|
if Assigned(Result) then begin
|
|
if (StrToDataType(Result.DataType)=rtDateTime)
|
|
then sa := '[paIsDateTime]'
|
|
else sa := '[]';
|
|
|
|
typname := GetDataType(Result.DataType);
|
|
if IsUserDefinedType(typname,aLibrary) then begin
|
|
typname := GetFullyQualifiedTypeName(typname,aLibrary,fUnitName);
|
|
end;
|
|
|
|
Write(Format('__Message.Read(''%s'', TypeInfo(%s), result, %s);',
|
|
[Result.Name, typname, sa]),InnerIndent);
|
|
end;
|
|
|
|
for p := 0 to (Count-1) do
|
|
if IsOutputFlag(Items[p].Flag) then begin
|
|
|
|
if (StrToDataType(Items[p].DataType)=rtDateTime)
|
|
then sa := '[paIsDateTime]'
|
|
else sa := '[]';
|
|
|
|
typname := GetDataType(Items[p].DataType);
|
|
if IsUserDefinedType(typname,aLibrary) then begin
|
|
typname := GetFullyQualifiedTypeName(typname,aLibrary,fUnitName);
|
|
end;
|
|
|
|
Write(Format('__Message.Read(''%s'', TypeInfo(%s), %s, %s);',
|
|
[Items[p].Name, typname, Items[p].Name, sa]),InnerIndent);
|
|
end;
|
|
end;
|
|
//Write('Message.Finalize;',InnerIndent);
|
|
|
|
Write(' finally');
|
|
(* if soapsvc then begin
|
|
Write(' if Supports(__TransportChannel, IROHTTPTransport, __http) then begin',InnerIndent);
|
|
Write(' if __TargetUrlWasSet then __http.TargetURL := '''';',InnerIndent);
|
|
Write(' end;',InnerIndent);
|
|
WriteEmptyLine;
|
|
end;*)
|
|
if sa <> '' then
|
|
Write(' __Message.UnsetAttributes(__TransportChannel);');
|
|
Write(' __Message.FreeStream;');
|
|
// Write(' __response.Free;');
|
|
Write(' end');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
function TRODLToIntf.IsSOAPService(aService: TRODLService): boolean;
|
|
begin
|
|
result := aService.Attributes.Values['Type'] = 'SOAP';
|
|
end;
|
|
|
|
procedure TRODLToIntf.WriteTypeDeclaration(aLibrary: TRODLLibrary; aType: TRODLEntity);
|
|
var
|
|
i : integer;
|
|
AList: TList;
|
|
s: string;
|
|
begin
|
|
Write(Format('{ %s }', [aType.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
// Structs
|
|
if (aType is TRODLStruct) then with TRODLStruct(aType) do begin
|
|
|
|
WriteDocumentation(aType);
|
|
if Ancestor <> '' then begin
|
|
Write(Format('%s = class(%s)', [Name,Ancestor]),PASCAL_INDENTATION_LEVEL_1);
|
|
end
|
|
else begin
|
|
Write(Format('%s = class(TROComplexType)', [Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
if Count > 0 then begin
|
|
|
|
Write('private',PASCAL_INDENTATION_LEVEL_1);
|
|
for i := 0 to (Count-1) do begin
|
|
Write(Format('f%s: %s;', [Items[i].Name, GetDataType(Items[i].DataType)]), PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
//WriteEmptyLine;
|
|
for i := 0 to (Count-1) do begin
|
|
//if IsStruct(Items[i].DataType, aLibrary) or IsArray(Items[i].DataType, aLibrary) then begin
|
|
if IsImplementedAsClass(Items[i].DataType, aLibrary) then begin
|
|
//Write(Format('procedure Set%s(Value : %s);', [Items[i].Name, Items[i].DataType]), PASCAL_INDENTATION_LEVEL_2);
|
|
Write(Format('function Get%s: %s;', [Items[i].Name, GetDataType(Items[i].DataType)]), PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
end;
|
|
|
|
Write('public',PASCAL_INDENTATION_LEVEL_1);
|
|
{Write(' constructor Create; override;',PASCAL_INDENTATION_LEVEL_1);
|
|
Write(' destructor Destroy; override;',PASCAL_INDENTATION_LEVEL_1);}
|
|
Write('procedure Assign(iSource: TPersistent); override;',PASCAL_INDENTATION_LEVEL_2);
|
|
if (CalcItemsMarshalingOrder(True).Count>0) and (Count > 0) then begin
|
|
Write('procedure ReadComplex(ASerializer: TObject); override;',PASCAL_INDENTATION_LEVEL_2);
|
|
Write('procedure WriteComplex(ASerializer: TObject); override;',PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
if aType.Attributes.Count > 0 then begin
|
|
WriteEmptyLine;
|
|
Write('class function GetAttributeCount: Integer; override;', PASCAL_INDENTATION_LEVEL_2);
|
|
Write('class function GetAttributeName(aIndex: Integer): string; override;', PASCAL_INDENTATION_LEVEL_2);
|
|
Write('class function GetAttributeValue(aIndex: Integer): string; override;', PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
//WriteEmptyLine;
|
|
Write('published',PASCAL_INDENTATION_LEVEL_1);
|
|
for i := 0 to (Count-1) do begin
|
|
//if IsStruct(Items[i].DataType, aLibrary) or IsArray(Items[i].DataType, aLibrary)
|
|
WriteDocumentation(Items[i]);
|
|
if IsImplementedAsClass(Items[i].DataType, aLibrary) then begin
|
|
Write(Format('property %s:%s read Get%s write f%s;',
|
|
[Items[i].Name, GetDataType(Items[i].DataType), Items[i].Name, Items[i].Name]), PASCAL_INDENTATION_LEVEL_2)
|
|
end
|
|
else begin
|
|
Write(Format('property %s:%s read f%s write f%s;',
|
|
[Items[i].Name, GetDataType(Items[i].DataType), Items[i].Name, Items[i].Name]), PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
end;
|
|
//WriteEmptyLine;
|
|
end;
|
|
Write('end;', PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
|
|
// Adds also a collection. This is handy when dealing with VCL wrappers
|
|
Write(Format('{ %sCollection }', [aType.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
if Ancestor <> '' then begin
|
|
Write(Format('%sCollection = class(%sCollection)', [Name,Ancestor]),PASCAL_INDENTATION_LEVEL_1);
|
|
end
|
|
else begin
|
|
Write(Format('%sCollection = class(TROCollection)', [Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
|
|
Write('protected', PASCAL_INDENTATION_LEVEL_1);
|
|
Write('constructor Create(aItemClass: TCollectionItemClass); overload;', PASCAL_INDENTATION_LEVEL_2);
|
|
Write(Format('function GetItems(aIndex: integer): %s;', [Name]), PASCAL_INDENTATION_LEVEL_2);
|
|
Write(Format('procedure SetItems(aIndex: integer; const Value: %s);', [Name]), PASCAL_INDENTATION_LEVEL_2);
|
|
Write('public', PASCAL_INDENTATION_LEVEL_1);
|
|
Write('constructor Create; overload;', PASCAL_INDENTATION_LEVEL_2);
|
|
|
|
Write(Format('function Add: %s; reintroduce;', [Name]), PASCAL_INDENTATION_LEVEL_2);
|
|
|
|
aList := TList.Create;
|
|
try
|
|
aLibrary.GetArraysByElement(Name,aList);
|
|
if aList.Count > 1 then s:= ' overload;' else s:='';
|
|
for i:=0 to aList.Count-1 do begin
|
|
Write(Format('procedure SaveToArray(anArray: %s);'+s, [TRODLArray(aList[i]).Name]), PASCAL_INDENTATION_LEVEL_2);
|
|
Write(Format('procedure LoadFromArray(anArray: %s);'+s, [TRODLArray(aList[i]).Name]), PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
finally
|
|
aList.Free;
|
|
end;
|
|
|
|
Write(Format('property Items[Index: integer]:%s read GetItems write SetItems; default;', [Name]), PASCAL_INDENTATION_LEVEL_2);
|
|
Write('end;', PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
end
|
|
|
|
// Arrays
|
|
else if (aType is TRODLArray) then with TRODLArray(aType) do begin
|
|
WriteDocumentation(aType);
|
|
Write(Format('%s_%s = array of %s;', [Name, ElementType,ElementType]), PASCAL_INDENTATION_LEVEL_1);
|
|
Write(Format('%s = class(TROArray)', [Name, ElementType]),PASCAL_INDENTATION_LEVEL_1);
|
|
Write('private',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
Write(' fCount: Integer;', PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
Write(Format(' fItems : %s_%s;', [Name, ElementType]), PASCAL_INDENTATION_LEVEL_1);
|
|
Write('protected',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
Write('procedure Grow; virtual;',PASCAL_INDENTATION_LEVEL_2);
|
|
|
|
Write(Format('function GetItems(aIndex: integer): %s;', [ElementType]),PASCAL_INDENTATION_LEVEL_2);
|
|
Write(Format('procedure SetItems(aIndex: integer; const Value: %s);', [ElementType]),PASCAL_INDENTATION_LEVEL_2);
|
|
Write('function GetCount: integer; override;',PASCAL_INDENTATION_LEVEL_2);
|
|
Write('public',PASCAL_INDENTATION_LEVEL_1);
|
|
Write(' class function GetItemType: PTypeInfo; override;',PASCAL_INDENTATION_LEVEL_1);
|
|
if IsImplementedAsClass(ElementType, aLibrary) then begin
|
|
Write(' class function GetItemClass: TClass; override;',PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
Write(' class function GetItemSize: integer; override;',PASCAL_INDENTATION_LEVEL_1);
|
|
Write(' function GetItemRef(aIndex: integer): pointer; override;',PASCAL_INDENTATION_LEVEL_1);
|
|
if not IsSimpleType(ElementType,aLibrary) then begin
|
|
Write(' procedure SetItemRef(aIndex: integer; Ref: pointer); override;',PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
Write(' procedure Clear; override;',PASCAL_INDENTATION_LEVEL_1);
|
|
Write(' procedure Delete(aIndex: integer); override;',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
Write(' procedure Resize(ElementCount: integer); override;',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
WriteEmptyLine;
|
|
|
|
Write('procedure Assign(iSource:TPersistent); override;',PASCAL_INDENTATION_LEVEL_2);
|
|
Write('procedure ReadComplex(ASerializer: TObject); override;',PASCAL_INDENTATION_LEVEL_2);
|
|
Write('procedure WriteComplex(ASerializer: TObject); override;',PASCAL_INDENTATION_LEVEL_2);
|
|
if aType.Attributes.Count > 0 then begin
|
|
WriteEmptyLine;
|
|
Write('class function GetAttributeCount: Integer; override;', PASCAL_INDENTATION_LEVEL_2);
|
|
Write('class function GetAttributeName(aIndex: Integer): string; override;', PASCAL_INDENTATION_LEVEL_2);
|
|
Write('class function GetAttributeValue(aIndex: Integer): string; override;', PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
|
|
if IsSimpleType(ElementType, aLibrary) then begin
|
|
Write(Format(' function Add(const Value:%s): integer;', [ElementType]), PASCAL_INDENTATION_LEVEL_1)
|
|
end
|
|
else begin
|
|
Write(Format(' function Add: %s; overload;', [ElementType]), PASCAL_INDENTATION_LEVEL_1);
|
|
Write(Format(' function Add(const Value: %s):integer; overload;', [ElementType]), PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
|
|
WriteEmptyLine;
|
|
Write(' property Count : integer read GetCount;',PASCAL_INDENTATION_LEVEL_1);
|
|
Write(Format(' property Items[Index: integer]:%s read GetItems write SetItems; default;', [ElementType]), PASCAL_INDENTATION_LEVEL_1);
|
|
Write(Format(' property InnerArray: %s_%s read fItems;', [Name, ElementType]), PASCAL_INDENTATION_LEVEL_1);
|
|
//WriteEmptyLine;
|
|
Write('end;',PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TRODLToIntf.WriteArraySerializer(aLibrary : TRODLLibrary; anArray : TRODLArray);
|
|
begin
|
|
with anArray do begin
|
|
Write('{ '+Name+' }');
|
|
WriteEmptyLine;
|
|
|
|
Write(Format('procedure %s.Assign(iSource: TPersistent);',[Name]));
|
|
Write(Format('var lSource:%s;',[Name]));
|
|
Write(Format(' i:integer;',[Name]));
|
|
Write('begin');
|
|
Write(Format(' if (iSource is %s) then begin',[Name]));
|
|
Write(Format(' lSource := %s(iSource);',[Name]));
|
|
Write(' Clear();');
|
|
Write(' Resize(lSource.Count);');
|
|
WriteEmptyLine;
|
|
Write(' for i := 0 to Count-1 do begin');
|
|
|
|
{if (ElementType = 'Binary') then begin
|
|
Write(' if Assigned(lSource.Items[i]) then begin');
|
|
Write(' Items[i] := Binary.Create();');
|
|
Write(' Items[i].Clear();');
|
|
Write(' Items[i].CopyFrom(lSource.Items[i],0);');
|
|
Write(' end;');
|
|
end
|
|
else} if IsImplementedAsClass(ElementType, aLibrary) then begin
|
|
Write(' if Assigned(lSource.Items[i]) then begin');
|
|
Write(Format(' Items[i].Assign(lSource.Items[i]);',[ElementType]));
|
|
Write(' end;');
|
|
end
|
|
else begin
|
|
Write(' Items[i] := lSource.Items[i];');
|
|
end;
|
|
|
|
Write(' end;');
|
|
Write(' end');
|
|
Write(' else begin');
|
|
Write(' inherited Assign(iSource);');
|
|
Write(' end;');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
// GetItemType
|
|
Write(Format('class function %s.GetItemType: PTypeInfo;', [Name]));
|
|
Write('begin');
|
|
Write(Format(' result := TypeInfo(%s);', [ElementType]));
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
// GetItemClass
|
|
if IsImplementedAsClass(ElementType, aLibrary) then begin
|
|
Write(Format('class function %s.GetItemClass: TClass;', [Name]));
|
|
Write( 'begin');
|
|
Write(Format(' result := %s;', [ElementType]));
|
|
Write( 'end;');
|
|
WriteEmptyLine;
|
|
end;
|
|
|
|
// GetItemSize
|
|
Write(Format('class function %s.GetItemSize: integer;', [Name]));
|
|
Write('begin');
|
|
Write(Format(' result := SizeOf(%s);', [ElementType]));
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
// GetItems
|
|
Write(Format('function %s.GetItems(aIndex: integer): %s;', [Name, ElementType]));
|
|
Write('begin');
|
|
Write(' if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);');
|
|
Write(' result := fItems[aIndex];');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
// GetItemRef
|
|
Write(Format('function %s.GetItemRef(aIndex: integer): pointer;', [Name]));
|
|
Write('begin');
|
|
Write(' if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);');
|
|
if IsSimpleType(ElementType, aLibrary)
|
|
then Write(' result := @fItems[aIndex];')
|
|
else Write(' result := fItems[aIndex];');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
// SetItemRef
|
|
if not IsSimpleType(ElementType, aLibrary) then begin
|
|
Write(Format('procedure %s.SetItemRef(aIndex: integer; Ref: pointer);', [Name]));
|
|
Write('begin');
|
|
Write(' if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);');
|
|
Write(' if Ref <> fItems[aIndex] then begin');
|
|
write(' if fItems[aIndex] <> nil then fItems[aIndex].Free;');
|
|
Write(' fItems[aIndex] := Ref;');
|
|
write(' end;');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
end;
|
|
|
|
// Clear
|
|
Write(Format('procedure %s.Clear;', [Name]));
|
|
if not IsSimpleType(ElementType, aLibrary) then Write('var i: integer;');
|
|
Write('begin');
|
|
if not IsSimpleType(ElementType, aLibrary) then Write(' for i := 0 to (Count-1) do fItems[i].Free();');
|
|
Write(' SetLength(fItems, 0);');
|
|
|
|
Write(' FCount := 0;');
|
|
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
// Delete
|
|
Write(Format('procedure %s.Delete(aIndex: integer);', [Name]));
|
|
//if not IsSimpleType(ElementType) then Write(' for i := 0 to (Count-1) do fItems[i].Free;');
|
|
Write('var i: integer;');
|
|
Write('begin');
|
|
Write(' if (aIndex>=Count) then RaiseError(err_InvalidIndex, [aIndex]);');
|
|
WriteEmptyLine;
|
|
if not IsSimpleType(ElementType, aLibrary) then begin
|
|
Write(' fItems[aIndex].Free();');
|
|
WriteEmptyLine;
|
|
end;
|
|
//ToDo: thic can probably be optimized???
|
|
Write(' if (aIndex<Count-1) then');
|
|
Write(' for i := aIndex to Count-2 do fItems[i] := fItems[i+1];'); // fixed from Count-1 to solve read bayond end of array.
|
|
WriteEmptyLine;
|
|
Write(' SetLength(fItems, Count-1);');
|
|
|
|
Write(' Dec(FCount);');
|
|
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
// SetItems
|
|
Write(Format('procedure %s.SetItems(aIndex: integer; const Value: %s);', [Name, ElementType]));
|
|
Write('begin');
|
|
Write(' if (aIndex < 0) or (aIndex >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[aIndex]);');
|
|
Write(' if fItems[aIndex] <> Value then begin');
|
|
if not IsSimpleType(ElementType, aLibrary) then
|
|
Write(' fItems[aIndex].Free;');
|
|
Write(' fItems[aIndex] := Value;');
|
|
Write(' end;');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
// Resize
|
|
Write(Format('procedure %s.Resize(ElementCount: integer);', [Name]));
|
|
if not IsSimpleType(ElementType, aLibrary) then begin
|
|
Write('var i: Integer;');
|
|
end;
|
|
Write('begin');
|
|
Write(' if fCount = ElementCount then Exit;');
|
|
if not IsSimpleType(ElementType, aLibrary) then begin
|
|
write(' for i := FCount -1 downto ElementCount do');
|
|
Write(' FItems[i].Free;');
|
|
end;
|
|
Write(' SetLength(fItems, ElementCount);');
|
|
if not IsSimpleType(ElementType, aLibrary) then begin
|
|
Write(' for i := FCount to ElementCount -1 do');
|
|
write(Format(' FItems[i] := %s.Create;', [ElementType]));
|
|
end;
|
|
Write(' FCount := ElementCount;');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
// GetCount
|
|
Write(Format('function %s.GetCount: integer;', [Name]));
|
|
Write('begin');
|
|
|
|
//Write(' result := Length(fItems);');
|
|
Write(' result := FCount;');
|
|
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
// Grow
|
|
Write(Format('procedure %s.Grow;', [Name]));
|
|
Write('var');
|
|
Write(' Delta, Capacity: Integer;');
|
|
Write('begin');
|
|
Write(' Capacity := Length(fItems);');
|
|
Write(' if Capacity > 64 then');
|
|
Write(' Delta := Capacity div 4');
|
|
Write(' else');
|
|
Write(' if Capacity > 8 then');
|
|
Write(' Delta := 16');
|
|
Write(' else');
|
|
Write(' Delta := 4;');
|
|
Write(' SetLength(fItems, Capacity + Delta);');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
// Add
|
|
if IsSimpleType(ElementType, aLibrary) then begin
|
|
Write(Format('function %s.Add(const Value: %s): integer;', [Name, ElementType]));
|
|
Write('begin');
|
|
|
|
//Write(' SetLength(fItems, Length(fItems)+1);');
|
|
//Write(' result := Length(fItems)-1;');
|
|
//Write(' fItems[result] := Value;');
|
|
Write(' Result := Count;');
|
|
Write(' if Length(fItems) = Result then');
|
|
Write(' Grow;');
|
|
Write(' fItems[result] := Value;');
|
|
Write(' Inc(fCount);');
|
|
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
end
|
|
else begin
|
|
Write(Format('function %s.Add: %s;', [Name, ElementType]));
|
|
Write('begin');
|
|
Write(Format(' result := %s.Create;', [ElementType]));
|
|
|
|
//Write(' SetLength(fItems, Length(fItems)+1);');
|
|
//Write(' fItems[Length(fItems)-1] := result;');
|
|
Write(' Add(Result);');
|
|
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
Write(Format('function %s.Add(const Value:%s): integer;', [Name, ElementType]));
|
|
Write('begin');
|
|
|
|
//Write(' SetLength(fItems, Length(fItems)+1);');
|
|
//Write(' result := Length(fItems)-1;');
|
|
//Write(' fItems[result] := Value;');
|
|
Write(' Result := Count;');
|
|
Write(' if Length(fItems) = Result then');
|
|
Write(' Grow;');
|
|
Write(' fItems[result] := Value;');
|
|
Write(' Inc(fCount);');
|
|
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
end;
|
|
|
|
Write(Format('procedure %s.ReadComplex(ASerializer: TObject);', [Name]));
|
|
Write('var');
|
|
Write(' lval: '+ElementType+';');
|
|
Write(' i: integer;');
|
|
// Write(' itemref : pointer;');
|
|
Write('begin');
|
|
Write(' for i := 0 to Count-1 do begin');
|
|
// write(' if (GetItemClass<>NIL) then itemref := NIL else itemref := GetItemRef(i);');
|
|
Write(' with TROSerializer(ASerializer) do');
|
|
case StrToDataType(ElementType) of
|
|
rtInteger: Write(' ReadInteger(GetArrayElementName(GetItemType, GetItemRef(i)), otSLong, lval, i);');
|
|
rtDateTime: Write(' ReadDateTime(GetArrayElementName(GetItemType, GetItemRef(i)), lval, i);');
|
|
rtDouble: Write(' ReadDouble(GetArrayElementName(GetItemType, GetItemRef(i)), ftDouble, lval, i);');
|
|
rtCurrency: Write(' ReadDouble(GetArrayElementName(GetItemType, GetItemRef(i)), ftCurr, lval, i);');
|
|
rtWidestring: Write(' ReadWideString(GetArrayElementName(GetItemType, GetItemRef(i)), lval, i);');
|
|
rtString: Write(' ReadUTF8String(GetArrayElementName(GetItemType, GetItemRef(i)), lval, i);');
|
|
rtInt64: Write(' ReadInt64(GetArrayElementName(GetItemType, GetItemRef(i)), lval, i);');
|
|
rtBoolean: Write(' ReadEnumerated(GetArrayElementName(GetItemType, GetItemRef(i)),TypeInfo(boolean), lval, i);');
|
|
rtVariant: Write(' ReadVariant(GetArrayElementName(GetItemType, GetItemRef(i)), lval, i);');
|
|
rtXML: Write(' ReadXML(GetArrayElementName(GetItemType, GetItemRef(i)), lval, i);');
|
|
rtGuid: Write(' ReadGuid(GetArrayElementName(GetItemType, GetItemRef(i)), lval, i);');
|
|
rtDecimal: Write(' ReadDecimal(GetArrayElementName(GetItemType, GetItemRef(i)), lval, i);');
|
|
rtBinary: Write(' ReadBinary(GetArrayElementName(GetItemType, GetItemRef(i)), lval, i);');
|
|
rtUserDefined:
|
|
if aLibrary.FindArray(ElementType) <> nil then
|
|
Write(Format(' ReadArray(GetArrayElementName(GetItemType, GetItemRef(i)), %s, lval, i);',[GetDataType(ElementType)]))
|
|
else if aLibrary.FindEnum(ElementType) <> nil then
|
|
Write(Format(' ReadEnumerated(GetArrayElementName(GetItemType, GetItemRef(i)),TypeInfo(%s), lval, i);',[GetDataType(ElementType)]))
|
|
else
|
|
Write(Format(' ReadStruct(GetArrayElementName(GetItemType, GetItemRef(i)), %s, lval, i);',[GetDataType(ElementType)]));
|
|
end;
|
|
Write(' Items[i] := lval;');
|
|
Write(' end;');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
Write(Format('procedure %s.WriteComplex(ASerializer: TObject);', [Name]));
|
|
Write('var');
|
|
Write(' i: integer;');
|
|
Write('begin');
|
|
Write(' for i := 0 to Count-1 do');
|
|
Write(' with TROSerializer(ASerializer) do');
|
|
case StrToDataType(ElementType) of
|
|
rtInteger: Write(' WriteInteger(GetArrayElementName(GetItemType, GetItemRef(i)), otSLong, fItems[i], i);');
|
|
rtDateTime: Write(' WriteDateTime(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], i);');
|
|
rtDouble: Write(' WriteDouble(GetArrayElementName(GetItemType, GetItemRef(i)), ftDouble, fItems[i], i);');
|
|
rtCurrency: Write(' WriteDouble(GetArrayElementName(GetItemType, GetItemRef(i)), ftCurr, fItems[i], i);');
|
|
rtWidestring: Write(' WriteWideString(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], i);');
|
|
rtString: Write(' WriteUTF8String(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], i);');
|
|
rtInt64: Write(' WriteInt64(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], i);');
|
|
rtBoolean: Write(' WriteEnumerated(GetArrayElementName(GetItemType, GetItemRef(i)),TypeInfo(boolean), fItems[i], i);');
|
|
rtVariant: Write(' WriteVariant(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], i);');
|
|
rtXML: Write(' WriteXML(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], i);');
|
|
rtGuid: Write(' WriteGuid(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], i);');
|
|
rtDecimal: Write(' WriteDecimal(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], i);');
|
|
rtBinary: Write(' WriteBinary(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], i);');
|
|
rtUserDefined:
|
|
if aLibrary.FindArray(ElementType) <> nil then
|
|
Write(' WriteArray(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], i);')
|
|
else if aLibrary.FindEnum(ElementType) <> nil then
|
|
Write(Format(' WriteEnumerated(GetArrayElementName(GetItemType, GetItemRef(i)),TypeInfo(%s), fItems[i], i);',[GetDataType(ElementType)]))
|
|
else
|
|
Write(' WriteStruct(GetArrayElementName(GetItemType, GetItemRef(i)), fItems[i], i);');
|
|
end;
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
if anArray.Attributes.Count > 0 then
|
|
WriteAttributesMethods(anArray);
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLToIntf.WriteStructPropMethods(aLibrary : TRODLLibrary; aStruct: TRODLStruct);
|
|
var i : integer;
|
|
//lWroteComment: boolean;
|
|
aList: TList;
|
|
structEntityList: IROStrings;
|
|
structEntity: TRODLTypedEntity;
|
|
begin
|
|
with aStruct do begin
|
|
{ Write(Format('constructor %s.Create;', [Name]));
|
|
Write('begin');
|
|
Write(' inherited;');
|
|
for i := 0 to (Count-1) do with Items[i] do begin
|
|
if not (IsStruct(DataType, aLibrary) or IsArray(DataType, aLibrary)) then Continue;
|
|
Write(Format(' fDestroy_%s := FALSE;', [Name]));
|
|
end;
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
Write(Format('destructor %s.Destroy;', [Name]));
|
|
Write('begin');
|
|
for i := 0 to (Count-1) do with Items[i] do begin
|
|
if not (IsStruct(DataType, aLibrary) or IsArray(DataType, aLibrary)) then Continue;
|
|
Write(Format(' if fDestroy_%s then FreeAndNIL(f%s);', [Name, Name]));
|
|
end;
|
|
Write(' inherited;');
|
|
Write('end;');
|
|
WriteEmptyLine;}
|
|
|
|
//lWroteComment := true;
|
|
//lWroteComment := false;
|
|
|
|
if Count > 0 then begin
|
|
Write('{ '+Name+' }');
|
|
WriteEmptyLine;
|
|
Write(Format('procedure %s.Assign(iSource: TPersistent); ',[aStruct.Name]));
|
|
Write(Format('var lSource: %s.%s;',[fUnitName, aStruct.Name]));
|
|
Write('begin');
|
|
Write(' inherited Assign(iSource);');
|
|
Write(Format(' if (iSource is %s.%s) then begin',[fUnitName, aStruct.Name]));
|
|
Write(Format(' lSource := %s.%s(iSource);',[fUnitName, aStruct.Name]));
|
|
for i := 0 to (Count-1) do begin
|
|
if IsImplementedAsClass(Items[i].DataType, aLibrary) then begin
|
|
if not AutoCreateParams then
|
|
Write(Format(' if Assigned(%s) then'#13#10, [Items[i].Name]));
|
|
Write(Format(' %s.Assign(lSource.%s);',[Items[i].Name,Items[i].Name]));
|
|
end
|
|
else begin
|
|
Write(Format(' %s := lSource.%s;',[Items[i].Name,Items[i].Name]));
|
|
end;
|
|
end;
|
|
Write(' end;');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
end;
|
|
|
|
for i := 0 to (Count-1) do with Items[i] do begin
|
|
if IsImplementedAsClass(DataType, aLibrary) then begin
|
|
//if not (IsStruct(DataType, aLibrary) or IsArray(DataType, aLibrary)) then Continue;
|
|
|
|
{Write(Format('procedure %s.Set%s(Value : %s);', [aStruct.Name, Name, DataType]));
|
|
Write('begin');
|
|
Write(Format(' if (f%s<>NIL) and (fDestroy_%s) then FreeAndNIL(f%s);', [Name, Name, Name]));
|
|
Write(Format(' f%s := Value;', [Name]));
|
|
Write(Format(' fDestroy_%s := FALSE;', [Name]));
|
|
Write('end;');
|
|
WriteEmptyLine;}
|
|
|
|
Write(Format('function %s.Get%s: %s;', [aStruct.Name, Name, GetDataType(DataType)]));
|
|
Write('begin');
|
|
if AutoCreateParams then
|
|
Write(Format(' if (f%s = nil) then f%s := %s.Create();', [Name, Name, GetDataType(DataType)]));
|
|
Write(Format(' result := f%s;', [Name]));
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
end;
|
|
end;
|
|
|
|
structEntityList:=CalcItemsMarshalingOrder(True);
|
|
if (structEntityList.Count>0) and (Count > 0) then begin
|
|
Write(Format('procedure %s.ReadComplex(ASerializer: TObject);', [Name]));
|
|
if structEntityList.Count > 0 then Write('var');
|
|
For i:=0 to structEntityList.Count - 1 do
|
|
with TRODLTypedEntity(structEntityList.Objects[i]) do
|
|
Write(Format(' l_%s: %s;',[Name, GetDataType(DataType)]));
|
|
Write('begin');
|
|
Write(' if TROSerializer(ASerializer).RecordStrictOrder then begin');
|
|
if Count <> structEntityList.Count then
|
|
Write(' inherited;');
|
|
For i:=0 to Count-1 do begin
|
|
structEntity:=Items[i];
|
|
Write(Format(' l_%s := %0:s;',[structEntity.Name]));
|
|
case StrToDataType(structEntity.DataType) of
|
|
rtInteger: Write(Format(' TROSerializer(ASerializer).ReadInteger(''%s'', otSLong, l_%0:s);',[structEntity.Name]));
|
|
rtDateTime: Write(Format(' TROSerializer(ASerializer).ReadDateTime(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtDouble: Write(Format(' TROSerializer(ASerializer).ReadDouble(''%s'', ftDouble, l_%0:s);',[structEntity.Name]));
|
|
rtCurrency: Write(Format(' TROSerializer(ASerializer).ReadDouble(''%s'', ftCurr, l_%0:s);',[structEntity.Name]));
|
|
rtWidestring: Write(Format(' TROSerializer(ASerializer).ReadWideString(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtString: Write(Format(' TROSerializer(ASerializer).ReadUTF8String(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtInt64: Write(Format(' TROSerializer(ASerializer).ReadInt64(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtBoolean: Write(Format(' TROSerializer(ASerializer).ReadEnumerated(''%s'',TypeInfo(boolean), l_%0:s);',[structEntity.Name]));
|
|
rtVariant: Write(Format(' TROSerializer(ASerializer).ReadVariant(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtXML: Write(Format(' TROSerializer(ASerializer).ReadXML(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtGuid: Write(Format(' TROSerializer(ASerializer).ReadGuid(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtDecimal: Write(Format(' TROSerializer(ASerializer).ReadDecimal(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtBinary: Write(Format(' TROSerializer(ASerializer).ReadBinary(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtUserDefined:
|
|
if aLibrary.FindArray(structEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).ReadArray(''%s'', %s, l_%0:s);',[structEntity.Name,GetDataType(structEntity.DataType)]))
|
|
else if aLibrary.FindEnum(structEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).ReadEnumerated(''%s'',TypeInfo(%s), l_%0:s);',[structEntity.Name,GetDataType(structEntity.DataType)]))
|
|
else
|
|
Write(Format(' TROSerializer(ASerializer).ReadStruct(''%s'', %s, l_%0:s);',[structEntity.Name,GetDataType(structEntity.DataType)]));
|
|
end;
|
|
if (StrToDataType(structEntity.DataType) in [rtBinary, rtUserDefined]) and (aLibrary.FindEnum(structEntity.DataType) = nil) then
|
|
Write(Format(' if %s <> l_%0:s then %0:s.Free;',[structEntity.Name]));
|
|
Write(Format(' %s := l_%0:s;',[structEntity.Name]));
|
|
end;
|
|
Write(' end');
|
|
Write(' else begin');
|
|
For i:=0 to structEntityList.Count-1 do begin
|
|
structEntity:=TRODLTypedEntity(structEntityList.Objects[i]);
|
|
Write(Format(' l_%s := %0:s;',[structEntity.Name]));
|
|
case StrToDataType(structEntity.DataType) of
|
|
rtInteger: Write(Format(' TROSerializer(ASerializer).ReadInteger(''%s'', otSLong, l_%0:s);',[structEntity.Name]));
|
|
rtDateTime: Write(Format(' TROSerializer(ASerializer).ReadDateTime(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtDouble: Write(Format(' TROSerializer(ASerializer).ReadDouble(''%s'', ftDouble, l_%0:s);',[structEntity.Name]));
|
|
rtCurrency: Write(Format(' TROSerializer(ASerializer).ReadDouble(''%s'', ftCurr, l_%0:s);',[structEntity.Name]));
|
|
rtWidestring: Write(Format(' TROSerializer(ASerializer).ReadWideString(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtString: Write(Format(' TROSerializer(ASerializer).ReadUTF8String(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtInt64: Write(Format(' TROSerializer(ASerializer).ReadInt64(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtBoolean: Write(Format(' TROSerializer(ASerializer).ReadEnumerated(''%s'',TypeInfo(boolean), l_%0:s);',[structEntity.Name]));
|
|
rtVariant: Write(Format(' TROSerializer(ASerializer).ReadVariant(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtXML: Write(Format(' TROSerializer(ASerializer).ReadXML(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtGuid: Write(Format(' TROSerializer(ASerializer).ReadGuid(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtDecimal: Write(Format(' TROSerializer(ASerializer).ReadDecimal(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtBinary: Write(Format(' TROSerializer(ASerializer).ReadBinary(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtUserDefined:
|
|
if aLibrary.FindArray(structEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).ReadArray(''%s'', %s, l_%0:s);',[structEntity.Name,GetDataType(structEntity.DataType)]))
|
|
else if aLibrary.FindEnum(structEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).ReadEnumerated(''%s'',TypeInfo(%s), l_%0:s);',[structEntity.Name,GetDataType(structEntity.DataType)]))
|
|
else
|
|
Write(Format(' TROSerializer(ASerializer).ReadStruct(''%s'', %s, l_%0:s);',[structEntity.Name,GetDataType(structEntity.DataType)]));
|
|
end;
|
|
if (StrToDataType(structEntity.DataType) in [rtBinary, rtUserDefined]) and (aLibrary.FindEnum(structEntity.DataType) = nil) then
|
|
Write(Format(' if %s <> l_%0:s then %0:s.Free;',[structEntity.Name]));
|
|
Write(Format(' %s := l_%0:s;',[structEntity.Name]));
|
|
end;
|
|
Write(' end;');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
Write(Format('procedure %s.WriteComplex(ASerializer: TObject);', [Name]));
|
|
if structEntityList.Count > 0 then Write('var');
|
|
For i:=0 to structEntityList.Count - 1 do
|
|
with TRODLTypedEntity(structEntityList.Objects[i]) do
|
|
Write(Format(' l_%s: %s;',[Name, GetDataType(DataType)]));
|
|
Write('begin');
|
|
Write(' if TROSerializer(ASerializer).RecordStrictOrder then begin');
|
|
if Count <> structEntityList.Count then
|
|
Write(' inherited;');
|
|
For i:=0 to Count-1 do begin
|
|
structEntity:=Items[i];
|
|
Write(Format(' l_%s := %0:s;',[structEntity.Name]));
|
|
case StrToDataType(structEntity.DataType) of
|
|
rtInteger: Write(Format(' TROSerializer(ASerializer).WriteInteger(''%s'', otSLong, l_%0:s);',[structEntity.Name]));
|
|
rtDateTime: Write(Format(' TROSerializer(ASerializer).WriteDateTime(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtDouble: Write(Format(' TROSerializer(ASerializer).WriteDouble(''%s'', ftDouble, l_%0:s);',[structEntity.Name]));
|
|
rtCurrency: Write(Format(' TROSerializer(ASerializer).WriteDouble(''%s'', ftCurr, l_%0:s);',[structEntity.Name]));
|
|
rtWidestring: Write(Format(' TROSerializer(ASerializer).WriteWideString(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtString: Write(Format(' TROSerializer(ASerializer).WriteUTF8String(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtInt64: Write(Format(' TROSerializer(ASerializer).WriteInt64(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtBoolean: Write(Format(' TROSerializer(ASerializer).WriteEnumerated(''%s'',TypeInfo(boolean), l_%0:s);',[structEntity.Name]));
|
|
rtVariant: Write(Format(' TROSerializer(ASerializer).WriteVariant(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtXML: Write(Format(' TROSerializer(ASerializer).WriteXML(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtGuid: Write(Format(' TROSerializer(ASerializer).WriteGuid(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtDecimal: Write(Format(' TROSerializer(ASerializer).WriteDecimal(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtBinary: Write(Format(' TROSerializer(ASerializer).WriteBinary(''%s'', l_%0:s);',[structEntity.Name]));
|
|
|
|
rtUserDefined:
|
|
if aLibrary.FindArray(structEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).WriteArray(''%s'', l_%0:s);',[structEntity.Name]))
|
|
else if aLibrary.FindEnum(structEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).WriteEnumerated(''%s'',TypeInfo(%s), l_%0:s);',[structEntity.Name,structEntity.DataType]))
|
|
else
|
|
Write(Format(' TROSerializer(ASerializer).WriteStruct(''%s'', l_%0:s);',[structEntity.Name]))
|
|
end;
|
|
end;
|
|
Write(' end');
|
|
Write(' else begin');
|
|
For i:=0 to structEntityList.Count-1 do begin
|
|
structEntity:=TRODLTypedEntity(structEntityList.Objects[i]);
|
|
Write(Format(' l_%s := %0:s;',[structEntity.Name]));
|
|
case StrToDataType(structEntity.DataType) of
|
|
rtInteger: Write(Format(' TROSerializer(ASerializer).WriteInteger(''%s'', otSLong, l_%0:s);',[structEntity.Name]));
|
|
rtDateTime: Write(Format(' TROSerializer(ASerializer).WriteDateTime(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtDouble: Write(Format(' TROSerializer(ASerializer).WriteDouble(''%s'', ftDouble, l_%0:s);',[structEntity.Name]));
|
|
rtCurrency: Write(Format(' TROSerializer(ASerializer).WriteDouble(''%s'', ftCurr, l_%0:s);',[structEntity.Name]));
|
|
rtWidestring: Write(Format(' TROSerializer(ASerializer).WriteWideString(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtString: Write(Format(' TROSerializer(ASerializer).WriteUTF8String(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtInt64: Write(Format(' TROSerializer(ASerializer).WriteInt64(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtBoolean: Write(Format(' TROSerializer(ASerializer).WriteEnumerated(''%s'',TypeInfo(boolean), l_%0:s);',[structEntity.Name]));
|
|
rtVariant: Write(Format(' TROSerializer(ASerializer).WriteVariant(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtXML: Write(Format(' TROSerializer(ASerializer).WriteXML(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtGuid: Write(Format(' TROSerializer(ASerializer).WriteGuid(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtDecimal: Write(Format(' TROSerializer(ASerializer).WriteDecimal(''%s'', l_%0:s);',[structEntity.Name]));
|
|
rtBinary: Write(Format(' TROSerializer(ASerializer).WriteBinary(''%s'', l_%0:s);',[structEntity.Name]));
|
|
|
|
rtUserDefined:
|
|
if aLibrary.FindArray(structEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).WriteArray(''%s'', l_%0:s);',[structEntity.Name]))
|
|
else if aLibrary.FindEnum(structEntity.DataType) <> nil then
|
|
Write(Format(' TROSerializer(ASerializer).WriteEnumerated(''%s'',TypeInfo(%s), l_%0:s);',[structEntity.Name,structEntity.DataType]))
|
|
else
|
|
Write(Format(' TROSerializer(ASerializer).WriteStruct(''%s'', l_%0:s);',[structEntity.Name]))
|
|
end;
|
|
end;
|
|
Write(' end;');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
if aStruct.Attributes.Count > 0 then
|
|
WriteAttributesMethods(aStruct);
|
|
end;
|
|
structEntityList:=nil;
|
|
|
|
// Writes the collection methods
|
|
Write('{ '+Name+'Collection }');
|
|
Write(Format('constructor %sCollection.Create;', [aStruct.Name]));
|
|
Write('begin');
|
|
Write(Format(' inherited Create(%s);', [aStruct.Name]));
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
Write(Format('constructor %sCollection.Create(aItemClass: TCollectionItemClass);', [aStruct.Name]));
|
|
Write('begin');
|
|
Write(Format(' inherited Create(aItemClass);', [aStruct.Name]));
|
|
Write('end;');
|
|
|
|
WriteEmptyLine;
|
|
Write(Format('function %sCollection.Add: %s;', [aStruct.Name, aStruct.Name]));
|
|
Write('begin');
|
|
Write(Format(' result := %s(inherited Add);', [aStruct.Name]));
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
Write(Format('function %sCollection.GetItems(aIndex: integer): %s;', [aStruct.Name, aStruct.Name]));
|
|
Write('begin');
|
|
Write(Format(' result := %s(inherited Items[aIndex]);', [aStruct.Name]));
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
aList := TList.Create;
|
|
try
|
|
aLibrary.GetArraysByElement(Name,aList);
|
|
for i := 0 to aList.Count-1 do begin
|
|
Write(Format('procedure %sCollection.LoadFromArray(anArray: %s);', [aStruct.Name, TRODLArray(aList[i]).Name]));
|
|
Write('var i : integer;');
|
|
Write('begin');
|
|
Write(' Clear;');
|
|
Write(' for i := 0 to (anArray.Count-1) do');
|
|
Write(' Add.Assign(anArray[i]);');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
Write(Format('procedure %sCollection.SaveToArray(anArray: %s);', [aStruct.Name, TRODLArray(aList[i]).Name]));
|
|
Write('var i : integer;');
|
|
Write('begin');
|
|
Write(' anArray.Clear;');
|
|
Write(' anArray.Resize(Count);');
|
|
Write(' for i := 0 to (Count-1) do begin');
|
|
Write(Format(' anArray[i] := %s.Create;', [aStruct.Name]));
|
|
Write(' anArray[i].Assign(Items[i]);');
|
|
Write(' end;');
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
end;
|
|
finally
|
|
aList.Free;
|
|
end;
|
|
|
|
Write(Format('procedure %sCollection.SetItems(aIndex: integer; const Value: %s);', [aStruct.Name, aStruct.Name]));
|
|
Write('begin');
|
|
Write(Format(' %s(inherited Items[aIndex]).Assign(Value);', [aStruct.Name, aStruct.Name]));
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
end;
|
|
end;
|
|
|
|
|
|
function GetAttributes(atOperation, atService, atLibrary: TStrings; Ident: Integer): string;
|
|
var
|
|
sl: TStringList;
|
|
s: string;
|
|
i, n: Integer;
|
|
begin
|
|
sl := TStringList.Create;
|
|
try
|
|
sl.AddStrings(atOperation);
|
|
sl.AddStrings(atService);
|
|
sl.AddStrings(atLibrary);
|
|
sl.Sort;
|
|
for i := sl.Count -1 downto 1 do begin
|
|
if sl[i] = sl[i-1] then sl.Delete(I); // remove dupes
|
|
end;
|
|
if sl.Count = 0 then begin result := ''; exit; end;
|
|
s := '';
|
|
for i := 0 to sl.Count -1 do begin
|
|
if sl[i] = '' then continue;
|
|
if i mod 8 = 7 then begin
|
|
s := s + #13#10;
|
|
setLength(s, Length(s) + Ident + 2);
|
|
for n := Length(s) - Ident -1 to Length(s) do
|
|
s[n] := ' ';
|
|
end;
|
|
if i <> 0 then s := s + ', ';
|
|
s := s + #39 + sl.Names[i] + #39;
|
|
end;
|
|
Result :='['+s+'], '#13#10;
|
|
setLength(Result, Length(Result) + Ident + 2);
|
|
for n := Length(Result) - Ident -1 to Length(Result) do
|
|
Result[n] := ' ';
|
|
|
|
s := '';
|
|
for i := 0 to sl.Count -1 do begin
|
|
if sl[i] = '' then continue;
|
|
if i mod 8 = 7 then begin
|
|
s := s + #13#10;
|
|
setLength(s, Length(s) + Ident + 2);
|
|
for n := Length(s) - Ident -1 to Length(s) do
|
|
s[n] := ' ';
|
|
end;
|
|
if i <> 0 then s := s + ', ';
|
|
s := s + #39 + StringReplace(sl.Values[sl.Names[i]], #39, #39#39, [rfReplaceAll]) + #39;
|
|
end;
|
|
Result := Result + '['+s+']';
|
|
finally
|
|
sl.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLToIntf.WriteAttributesMethods(anEntity: TRODLEntity);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
with anEntity do begin
|
|
Write(Format('class function %s.GetAttributeCount: Integer;',[Name]));
|
|
Write('begin');
|
|
Write(Format('result := %d;', [Attributes.Count]), PASCAL_INDENTATION_LEVEL_1);
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
Write(Format('class function %s.GetAttributeName(aIndex: Integer): string;',[Name]));
|
|
Write('begin');
|
|
if Attributes.Count > 0 then begin
|
|
Write('case aIndex of', PASCAL_INDENTATION_LEVEL_1);
|
|
for i := 0 to Attributes.Count - 1 do
|
|
Write(Format('%d: result := %s;', [i, QuotedStr(Attributes.Names[i])]), PASCAL_INDENTATION_LEVEL_2);
|
|
Write('end;', PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
|
|
Write(Format('class function %s.GetAttributeValue(aIndex: Integer): string;',[Name]));
|
|
Write('begin');
|
|
if Attributes.Count > 0 then begin
|
|
Write('case aIndex of', PASCAL_INDENTATION_LEVEL_1);
|
|
for i := 0 to Attributes.Count - 1 do
|
|
Write(Format('%d: result := %s;', [i, QuotedStr(Attributes.Values[Attributes.Names[i]])]), PASCAL_INDENTATION_LEVEL_2);
|
|
Write('end;', PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
Write('end;');
|
|
WriteEmptyLine;
|
|
end;
|
|
end;
|
|
|
|
end.
|