david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
2978 lines
94 KiB
ObjectPascal
2978 lines
94 KiB
ObjectPascal
unit uRODL;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Core Library }
|
|
{ }
|
|
{ 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. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I RemObjects.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, Contnrs, uROClasses;
|
|
|
|
const
|
|
EmptyGUID: TGUID = (D1: 0; D2: 0; D3: 0; D4: (0, 0, 0, 0, 0, 0, 0, 0));
|
|
|
|
DefaultIntfName = 'Default';
|
|
|
|
type
|
|
{ Misc types }
|
|
TRODLParamFlag = (fIn, fOut, fInOut, fResult);
|
|
|
|
const
|
|
RODLParamFlagNames: array[TRODLParamFlag] of string = ('in', 'out', 'in/out', 'result');
|
|
|
|
type
|
|
{ TRODLNameInfo }
|
|
TRODLEntity = class;
|
|
TRODLLibrary = class;
|
|
|
|
TRoPluginMessageType = (rmtInfo, rmtHint, rmtWarning, rmtError, rmtSuccess, rmtCustom);
|
|
|
|
IROPluginMessages = interface
|
|
['{9B07B5C2-FC07-4B9B-9207-D487CDC58D0E}']
|
|
procedure AddMessage(iType:TRoPluginMessageType; const iSource, iMessage:string; aReserved:integer=-1; aEntity:TRODLEntity=nil);
|
|
end;
|
|
|
|
IRODLEntityWithAncestor = interface
|
|
['{88D59A20-5B47-4CF0-A06C-C135EB598B12}']
|
|
function GetAncestor:string;
|
|
procedure SetAncestor(const iValue:string);
|
|
property Ancestor:string read GetAncestor write SetAncestor;
|
|
end;
|
|
|
|
TRODLUse = class;
|
|
TRODLGroup = class;
|
|
|
|
{ TRODLEntity }
|
|
TRODLEntity = class(TObject, IUnknown)
|
|
private
|
|
fIsFromUsedRodl: boolean;
|
|
fLocatedInRodlUse: TRODLUse;
|
|
fOwner:TRODLEntity;
|
|
|
|
fData: TObject;
|
|
fGroupUnder: TRODLGroup;
|
|
|
|
fName: string;
|
|
fAttributes: TStringList;
|
|
fDocumentation: string;
|
|
fUID: TGUID;
|
|
|
|
procedure SetName(const Value: string); virtual;
|
|
procedure SetDocumentation(const Value: string);
|
|
function GetAttributes: TStrings;
|
|
|
|
function GetInfo: TRODLEntity;
|
|
function GetOwnerLibrary: TRODLLibrary;
|
|
|
|
protected
|
|
function _AddRef: Integer; stdcall;
|
|
function _Release: Integer; stdcall;
|
|
function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
|
|
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
|
|
procedure Validate(iMessages:IRoPluginMessages); virtual;
|
|
//function Validate(out FaultyEntity: TRODLEntity; out ErrorMessage: string): boolean; virtual;
|
|
|
|
property Name: string read fName write SetName;
|
|
property Documentation: string read fDocumentation write SetDocumentation;
|
|
property UID: TGUID read fUID write fUID;
|
|
property Attributes: TStrings read GetAttributes;
|
|
|
|
property Owner:TRODLEntity read fOwner;
|
|
property OwnerLibrary:TRODLLibrary read GetOwnerLibrary;
|
|
|
|
property Info: TRODLEntity read GetInfo; { for backwards comatibility }
|
|
property IsFromUsedRodl:boolean read fIsFromUsedRodl write fIsFromUsedRodl;
|
|
property LocatedInRodlUse:TRODLUse read fLocatedInRodlUse write fLocatedInRodlUse;
|
|
|
|
{ Helpers for visual representation in SB and elsewhere }
|
|
property GroupUnder:TRODLGroup read fGroupUnder write fGroupUnder;
|
|
class function ReadableEntityTypeName: string;
|
|
|
|
{ Properties to hold custom application-specific data at runtime, for
|
|
the application coding convenience. These are not persisted in any way }
|
|
property Data:TObject read fData write fData;
|
|
|
|
end;
|
|
|
|
TRODLEntityClass = class of TRODLEntity;
|
|
|
|
TRODLGroup = class(TRODLEntity)
|
|
end;
|
|
|
|
{ TRODLComplexEntity }
|
|
TRODLComplexEntity = class(TRODLEntity)
|
|
private
|
|
fItems: TObjectList;
|
|
fAutoCreateParams: boolean;
|
|
fAbstract: boolean;
|
|
|
|
function GetCount: integer;
|
|
function GetItems(Index: integer): TRODLEntity;
|
|
|
|
protected
|
|
function GetItemClass: TRODLEntityClass; virtual; abstract;
|
|
|
|
public
|
|
constructor Create; override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Validate(iMessages:IRoPluginMessages); override;
|
|
//function Validate(out FaultyEntity: TRODLEntity; out ErrorMessage: string): boolean; override;
|
|
|
|
function ContainsEntity(aEntity: TRODLEntity; aRecurse:boolean=true):boolean;
|
|
|
|
function ItemByName(const aName: string): TRODLEntity;
|
|
function ItemByUID(const aUID: TGUID): TRODLEntity;
|
|
|
|
function Add(anEntity: TRODLEntity): integer; overload; virtual;
|
|
function Add: TRODLEntity; overload; virtual;
|
|
procedure Insert(aIndex: integer; anEntity: TRODLEntity); overload; virtual;
|
|
function Insert(aIndex: integer): TRODLEntity; overload; virtual;
|
|
|
|
function UniqueName(aBaseName:string):string;
|
|
|
|
procedure Exchange(Index1, Index2: integer); virtual;
|
|
|
|
|
|
procedure Remove(anEntity: TRODLEntity); virtual;
|
|
procedure Delete(Index: integer); virtual;
|
|
procedure Clear;
|
|
procedure Sort;
|
|
|
|
property AutoCreateParams:boolean read fAutoCreateParams write fAutoCreateParams;
|
|
property Abstract:boolean read fAbstract write fAbstract;
|
|
|
|
property ItemClass: TRODLEntityClass read GetItemClass;
|
|
property Items[Index: integer]: TRODLEntity read GetItems; default;
|
|
property Count: integer read GetCount;
|
|
|
|
end;
|
|
|
|
{ TRODLTypedEntity }
|
|
TRODLTypedEntity = class(TRODLEntity)
|
|
private
|
|
fDataType: string;
|
|
procedure SetDataType(const Value: string);
|
|
public
|
|
procedure Validate(iMessages: IRoPluginMessages); override;
|
|
property DataType: string read fDataType write SetDataType;
|
|
end;
|
|
|
|
{ TRODLStruct }
|
|
TRODLBaseStruct = class(TRODLComplexEntity, IRODLEntityWithAncestor)
|
|
private
|
|
fAncestor: string;
|
|
function GetItems(Index: integer): TRODLTypedEntity;
|
|
procedure SetAncestor(const Value: string);
|
|
|
|
protected
|
|
function GetItemClass: TRODLEntityClass; override;
|
|
function IsDerivedFrom(aBaseStruct: TRODLBaseStruct): Boolean; virtual;
|
|
|
|
public
|
|
function Add(aStructElement: TRODLTypedEntity): integer; reintroduce; overload;
|
|
function Add: TRODLTypedEntity; reintroduce; overload;
|
|
|
|
procedure Validate(iMessages:IRoPluginMessages); override;
|
|
property Items[Index: integer]: TRODLTypedEntity read GetItems; default;
|
|
property Ancestor: string read fAncestor write SetAncestor;
|
|
function GetAncestor: string;
|
|
|
|
function CalcItems(aIncludeAncestors: boolean=true; aIgnoreDuplicates: boolean=true): IROStrings;
|
|
function CalcItemsMarshalingOrder(aIncludeAncestors: boolean=true): IROStrings;
|
|
end;
|
|
|
|
TRODLStruct = class(TRODLBaseStruct);
|
|
|
|
{ TRODLArray }
|
|
TRODLArray = class(TRODLEntity)
|
|
private
|
|
fElementType: string;
|
|
procedure SetElementType(const Value: string);
|
|
public
|
|
procedure Validate(iMessages:IRoPluginMessages); override;
|
|
//function Validate(out FaultyEntity: TRODLEntity; out ErrorMessage: string): boolean; override;
|
|
|
|
property ElementType: string read fElementType write SetElementType;
|
|
end;
|
|
|
|
{ TRODLEnumValue }
|
|
TRODLEnumValue = class(TRODLEntity)
|
|
private
|
|
end;
|
|
|
|
{ TRODLEnum }
|
|
TRODLEnum = class(TRODLComplexEntity)
|
|
private
|
|
fPrefixEnumValues: Boolean;
|
|
function GetItems(Index: integer): TRODLEnumValue;
|
|
|
|
protected
|
|
function GetItemClass: TRODLEntityClass; override;
|
|
|
|
public
|
|
constructor Create; override;
|
|
|
|
function Add(aStructElement: TRODLEnumValue): integer; reintroduce; overload;
|
|
function Add: TRODLEnumValue; reintroduce; overload;
|
|
|
|
procedure Validate(iMessages:IRoPluginMessages); override;
|
|
property Items[Index: integer]: TRODLEnumValue read GetItems; default;
|
|
|
|
property PrefixEnumValues: Boolean read fPrefixEnumValues write fPrefixEnumValues;
|
|
end;
|
|
|
|
{ TRODLOperationParam }
|
|
TRODLOperationParam = class(TRODLTypedEntity)
|
|
private
|
|
fFlag: TRODLParamFlag;
|
|
function GetFlag: string;
|
|
procedure SetFlag(const aValue: string);
|
|
public
|
|
property Flag: TRODLParamFlag read fFlag write fFlag;
|
|
property FlagAsString: string read GetFlag write SetFlag;
|
|
end;
|
|
|
|
{ TRODLOperation }
|
|
TRODLOperation = class(TRODLComplexEntity)
|
|
private
|
|
fOperationResult: TRODLOperationParam;
|
|
fCodeBodies: TStringList;
|
|
fForceAsyncResponse: boolean;
|
|
function GetItems(Index: integer): TRODLOperationParam;
|
|
function GetResult: TRODLOperationParam;
|
|
function GetCodeBody(iLanguage: string): TStrings;
|
|
function GetCodeBodyCount: integer;
|
|
function GetCodeBodyLanguages(iIndex: integer): string;
|
|
|
|
protected
|
|
function GetItemClass: TRODLEntityClass; override;
|
|
|
|
public
|
|
constructor Create; override;
|
|
destructor Destroy; override;
|
|
|
|
function Add(aParam: TRODLOperationParam): integer; reintroduce; overload;
|
|
function Add: TRODLOperationParam; reintroduce; overload;
|
|
|
|
{procedure MoveResult();
|
|
procedure Exchange(Index1, Index2: integer); override;}
|
|
|
|
procedure SetCodeBody(iLanguage: string; Value: TStrings);
|
|
procedure SetCodeBodyAsString(iLanguage: string; const Value: string);
|
|
|
|
function GetParameter(const aParameterName : string) : TRODLOperationParam;
|
|
|
|
property Items[Index: integer]: TRODLOperationParam read GetItems; default;
|
|
|
|
property Result: TRODLOperationParam read GetResult;
|
|
function AddResult: TRODLOperationParam;
|
|
procedure RemoveResult;
|
|
|
|
property ForceAsyncResponse:boolean read fForceAsyncResponse write fForceAsyncResponse;
|
|
|
|
property CodeBodies[iLanguage:string]:TStrings read GetCodeBody write SetCodeBody;
|
|
property CodeBodyCount:integer read GetCodeBodyCount;
|
|
property CodeBodyLanguages[iIndex:integer]:string read GetCodeBodyLanguages;
|
|
|
|
procedure Validate(iMessages: IROPluginMessages); override;
|
|
end;
|
|
|
|
{ TRODLServiceInterface }
|
|
TRODLServiceInterface = class(TRODLComplexEntity)
|
|
private
|
|
function GetItems(Index: integer): TRODLOperation;
|
|
|
|
protected
|
|
function GetItemClass: TRODLEntityClass; override;
|
|
|
|
public
|
|
procedure GetOperationsList(AList: TList);
|
|
function FindOperation(const anOperationName : string; IncludeAnchestors : boolean = FALSE) : TRODLOperation;
|
|
function GetOperation(const anOperationName : string; IncludeAnchestors : boolean = FALSE) : TRODLOperation;
|
|
|
|
function CalcItems(aIncludeAncestors: boolean=true; aIgnoreDuplicates: boolean=true): IROStrings;
|
|
|
|
function Add(aParam: TRODLOperation): integer; reintroduce; overload;
|
|
function Add: TRODLOperation; reintroduce; overload;
|
|
|
|
property Items[Index: integer]: TRODLOperation read GetItems; default;
|
|
end;
|
|
|
|
{ TRODLBaseService }
|
|
TRODLBaseService = class(TRODLComplexEntity, IRODLEntityWithAncestor)
|
|
private
|
|
fAncestor: string;
|
|
fImplClass: string;
|
|
fImplUnit: string;
|
|
fisPrivate: Boolean;
|
|
function GetItems(Index: integer): TRODLServiceInterface;
|
|
function GetDefault: TRODLServiceInterface;
|
|
procedure SetAncestor(const Value: string);
|
|
|
|
protected
|
|
function GetItemClass: TRODLEntityClass; override;
|
|
function IsDerivedFrom(aBaseService: TRODLBaseService): Boolean; virtual;
|
|
public
|
|
constructor Create; override;
|
|
|
|
function Add(aServiceInterface: TRODLServiceInterface): integer; reintroduce; overload;
|
|
function Add: TRODLServiceInterface; reintroduce; overload;
|
|
|
|
procedure Validate(iMessages: IRoPluginMessages); override;
|
|
property Items[Index: integer]: TRODLServiceInterface read GetItems; default;
|
|
property Default: TRODLServiceInterface read GetDefault;
|
|
property Ancestor: string read fAncestor write SetAncestor;
|
|
|
|
property ImplUnit:string read fImplUnit write fImplUnit;
|
|
property ImplClass:string read fImplClass write fImplClass;
|
|
function GetAncestor:string;
|
|
property isPrivate: Boolean read fisPrivate write fisPrivate;
|
|
end;
|
|
|
|
TRODLService = class(TRODLBaseService);
|
|
TRODLEventSink = class(TRODLBaseService);
|
|
|
|
{ TRODLArray }
|
|
TRODLException = class(TRODLBaseStruct)
|
|
public
|
|
procedure Validate(iMessages:IRoPluginMessages); override;
|
|
end;
|
|
|
|
{ TRODLUse }
|
|
TRODLUseSplitMode = (usmAsParent, usmNever, usmAlways);
|
|
TRODLUse = class(TRODLEntity)
|
|
private
|
|
fRodlFile: string;
|
|
fAbsoluteRodlFile: string;
|
|
fLoadedRodlLibraryName: string;
|
|
fGenerateCode: boolean;
|
|
fSplitMode: TRODLUseSplitMode;
|
|
public
|
|
procedure Validate(iMessages:IRoPluginMessages); override;
|
|
property RodlFile:string read fRodlFile write fRodlFile;
|
|
property AbsoluteRodlFile:string read fAbsoluteRodlFile write fAbsoluteRodlFile;
|
|
property LoadedRodlLibraryName: string read fLoadedRodlLibraryName write fLoadedRodlLibraryName;
|
|
property GenerateCode: boolean read fGenerateCode write fGenerateCode;
|
|
property SplitMode: TRODLUseSplitMode read fSplitMode write fSplitMode;
|
|
end;
|
|
|
|
{ TRODLLibrary }
|
|
TRODLLibrary = class(TRODLComplexEntity)
|
|
private
|
|
fArrayCount: integer;
|
|
fServiceCount: integer;
|
|
fStructCount: integer;
|
|
fEnumCount: integer;
|
|
fExceptionCount: integer;
|
|
fUseCount: integer;
|
|
fEventSinkCount: integer;
|
|
fGroupCount: integer;
|
|
fRodlFilename: string;
|
|
fNamespace: string;
|
|
|
|
function GetByType(aIndex:integer; aType:TRODLEntityClass):TRODLEntity;
|
|
function GetArray(Index: integer): TRODLArray;
|
|
function GetEnums(Index: integer): TRODLEnum;
|
|
function GetServices(Index: integer): TRODLService;
|
|
function GetStructs(Index: integer): TRODLStruct;
|
|
function GetExceptions(Index: integer): TRODLException;
|
|
function GetUse(Index: integer): TRODLUse;
|
|
function CalcOrder(const iObjects: IROStrings): IROStrings;
|
|
function GetGroups(Index: integer): TRODLGroup;
|
|
function GetEventSinks(Index: integer): TRODLEventSink;
|
|
|
|
protected
|
|
function GetItemClass: TRODLEntityClass; override;
|
|
|
|
public
|
|
constructor Create(); override;
|
|
|
|
procedure GetArraysByElement(const aElementName:string; AList: TList);
|
|
function FindBaseService(const iServiceName: string): TRODLBaseService;
|
|
function FindService(const iServiceName: string): TRODLService;
|
|
function FindStruct(const iStructName: string): TRODLStruct;
|
|
function FindBaseStruct(const iStructName: string): TRODLBaseStruct;
|
|
function FindEnum(const iEnumName: string): TRODLEnum;
|
|
function FindArray(const iArrayName: string): TRODLArray;
|
|
function FindGroup(const aID: TGUID): TRODLGroup; overload;
|
|
function FindException(const iExceptionName: string): TRODLException;
|
|
function FindUse(const iUseName: string): TRODLUse;
|
|
function FindUseByFilename(const iUseRODLFile: string): TRODLUse;
|
|
|
|
procedure ClearDuplicates();
|
|
|
|
function GetService(const aServiceName: string): TRODLService;
|
|
function GetStruct(const aStructName: string): TRODLStruct;
|
|
|
|
function IsValidCustomType(const iTypeName:string):boolean;
|
|
function IsValidSimpleType(const iTypeName: string): boolean;
|
|
function IsValidType(const iTypeName:string):boolean;
|
|
function IsValidService(const iServiceName:string):boolean;
|
|
function IsValidEventSink(const iEventSink:string):boolean;
|
|
function IsValidException(const iTypeName:string):boolean;
|
|
|
|
function Add(anEntity: TRODLEntity): integer; override;
|
|
|
|
function CalcServiceOrder:IROStrings;
|
|
function CalcEventSinkOrder: IROStrings;
|
|
function CalcExceptionOrder: IROStrings;
|
|
function CalcStructOrder: IROStrings;
|
|
|
|
procedure Delete(Index: integer); override;
|
|
procedure Remove(anEntity: TRODLEntity); override;
|
|
|
|
property RodlFilename:string read fRodlFilename write fRodlFilename;
|
|
property Namespace: string read fNamespace write fNamespace;
|
|
|
|
property Structs[Index: integer]: TRODLStruct read GetStructs;
|
|
property StructCount: integer read fStructCount;
|
|
|
|
property Arrays[Index: integer]: TRODLArray read GetArray;
|
|
property ArrayCount: integer read fArrayCount;
|
|
|
|
property Enums[Index: integer]: TRODLEnum read GetEnums;
|
|
property EnumCount: integer read fEnumCount;
|
|
|
|
property Services[Index: integer]: TRODLService read GetServices;
|
|
property ServiceCount: integer read fServiceCount;
|
|
|
|
property Exceptions[Index: integer]: TRODLException read GetExceptions;
|
|
property ExceptionCount: integer read fExceptionCount;
|
|
|
|
property Use[Index: integer]: TRODLUse read GetUse;
|
|
property UseCount: integer read fUseCount;
|
|
|
|
property Groups[Index: integer]: TRODLGroup read GetGroups;
|
|
property GroupCount: integer read fGroupCount;
|
|
|
|
property EventSinks[Index: integer]: TRODLEventSink read GetEventSinks;
|
|
property EventSinkCount: integer read fEventSinkCount;
|
|
end;
|
|
|
|
{ TRODLConverter }
|
|
TRODLConverter = class
|
|
private
|
|
fBuffer: TStringList;
|
|
fTargetEntity: string;
|
|
|
|
function GetBuffer: TStrings;
|
|
|
|
protected
|
|
procedure IntConvert(const aLibrary: TRODLLibrary; const aTargetEntity: string = ''); virtual; abstract;
|
|
function ValidateTargetEntity(const aLibrary: TRODLLibrary; const aTargetEntity: string): boolean; virtual;
|
|
|
|
public
|
|
constructor Create(const aLibraryFile: string; const aTargetEntity: string = ''); overload; virtual;
|
|
constructor Create(const aLibrary: TRODLLibrary; const aTargetEntity: string = ''); overload; virtual;
|
|
destructor Destroy; override;
|
|
|
|
procedure Write(const someText: string; Indentation: integer = 0); overload;
|
|
procedure WriteLines(const someText: string);
|
|
procedure WriteEmptyLine;
|
|
|
|
procedure Convert(const aLibrary: TRODLLibrary; const aTargetEntity: string = '');
|
|
class function GetTargetFileName(const aLibrary: TRODLLibrary; const aTargetEntity: string = ''): string; virtual;
|
|
|
|
property Buffer: TStrings read GetBuffer;
|
|
property TargetEntity: string read fTargetEntity;
|
|
end;
|
|
|
|
TRODLConverterClass = class of TRODLConverter;
|
|
|
|
{ TRODLReader }
|
|
TRODLReader = class
|
|
private
|
|
protected
|
|
function IntReadFromStream(aStream: TStream; aFilename:string): TRODLLibrary; virtual; abstract;
|
|
|
|
public
|
|
constructor Create; virtual;
|
|
|
|
function Read(aStream: TStream; const aFilename:string=''): TRODLLibrary;
|
|
function ReadFromFile(const aFileName: string): TRODLLibrary;
|
|
end;
|
|
|
|
TRODLReaderClass = class of TRODLReader;
|
|
|
|
{ TXMLToRODL }
|
|
TXMLToRODL = class(TRODLReader)
|
|
private
|
|
fAddToExistingLibrary:TRODLLibrary;
|
|
fRecreateGuids:boolean;
|
|
procedure LoadStreamToLibrary(aStream: TStream; iLibrary: TRODLLibrary; iRodlName: string = ''; iRodlUse: TRODLUse=nil; iReplaceLibraryAttributes:boolean=true);
|
|
function RecreateGuidIfNeeded(iGuid:TGuid):TGuid;
|
|
protected
|
|
function IntReadFromStream(aStream: TStream; aFilename:string): TRODLLibrary; override;
|
|
|
|
public
|
|
constructor Create(iAddToExisting:TRODLLibrary; iRecreateGuids:boolean=false); reintroduce; overload;
|
|
procedure LoadFileToLibrary(iFilename: string; iLibrary: TRODLLibrary; iRodlUse:TRODLUse=nil);
|
|
|
|
function ReadFromString(const aString: string; const aFilename:string=''): TRODLLibrary;
|
|
end;
|
|
|
|
function ReadRODLFromFile(aReaderClass: TRODLReaderClass; const aFileName: string): TRODLLibrary;
|
|
|
|
function ExpandVariables(const aFilename:string):string;
|
|
|
|
type
|
|
XMLFlagNamesArray = array[TRODLParamFlag] of string;
|
|
const
|
|
XMLFlagNames: XMLFlagNamesArray = ('In', 'Out', 'InOut', 'Result');
|
|
|
|
function XMLFlagNameToFlag(const aName: string): TRODLParamFlag;
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF DEBUG_REMOBJECTS_RODL}eDebugServer, {$ENDIF}
|
|
{$IFDEF DELPHI5} ActiveX, Windows, {$ENDIF}
|
|
{$IFDEF MSWINDOWS}Registry, {$IFNDEF DELPHI5}Windows,{$ENDIF}{$ENDIF}
|
|
SysUtils, TypInfo, uRORes, uROXMLIntf{,uROTypes};
|
|
|
|
{ Support routines }
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function LookupVariable(const aVariable:string):string;
|
|
begin
|
|
with TRegistry.Create do try
|
|
RootKey := HKEY_CURRENT_USER;
|
|
OpenKey('Software\RemObjects\RemObjects SDK\Variables',false);
|
|
result := ReadString(aVariable);
|
|
{ if result = '' then
|
|
RaiseError('Variable $(%s) used in RODL is not defined.',[aVariable]);
|
|
}
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function ExpandVariables(const aFilename:string):string;
|
|
var
|
|
p: Integer;
|
|
lName,lVar:string;
|
|
begin
|
|
lName := aFilename;
|
|
if Pos('$(',lName) = 1 then begin
|
|
p := Pos(')',lName);
|
|
if p > 1 then begin
|
|
lVar := Copy(lName,3,p-3);
|
|
Delete(lName,1,p);
|
|
result := LookupVariable(lVar)+lName;
|
|
exit;
|
|
end;
|
|
end;
|
|
result := aFilename;
|
|
end;
|
|
{$ELSE}
|
|
function ExpandVariables(const aFilename:string):string;
|
|
begin
|
|
result := aFilename;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function CleanupText(const someText: string): string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := Trim(someText);
|
|
for i := 1 to Length(result) do
|
|
case result[i] of
|
|
'0'..'9': begin
|
|
if (i = 1) then result[i] := '_';
|
|
end;
|
|
'a'..'z',
|
|
'A'..'Z',
|
|
'_': Continue;
|
|
else
|
|
result[i] := '_';
|
|
end;
|
|
end;
|
|
|
|
function CleanupTextAllowSpaces(const someText: string): string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := Trim(someText);
|
|
for i := 1 to Length(result) do
|
|
case result[i] of
|
|
{'0'..'9' : begin
|
|
if (i=1) then result[i] := '_';
|
|
end;}
|
|
#13, #10, #09,
|
|
#$20..#$21,
|
|
#$23..#$25,
|
|
#$27..#$3b,
|
|
#$3d,
|
|
#$3f..#$7e: Continue;
|
|
else
|
|
result[i] := '_';
|
|
end;
|
|
end;
|
|
|
|
function ReadRODLFromFile(aReaderClass: TRODLReaderClass; const aFileName: string): TRODLLibrary;
|
|
begin
|
|
with aReaderClass.Create do try
|
|
result := ReadFromFile(aFileName);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
{ TRODLNameInfo }
|
|
|
|
{constructor TRODLNameInfo.Create(const aName: string; aOwner:TRODLEntity);
|
|
begin
|
|
Name := aName;
|
|
fOwner := aOwner;
|
|
fUID := NewUID();
|
|
end;
|
|
|
|
destructor TRODLNameInfo.Destroy;
|
|
begin
|
|
if Assigned(fAttributes) then fAttributes.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TRODLNameInfo.GetAttributes: TStrings;
|
|
begin
|
|
if (fAttributes = nil) then fAttributes := TStringList.Create;
|
|
result := fAttributes;
|
|
end;
|
|
|
|
procedure TRODLNameInfo.SetName(const Value: string);
|
|
begin
|
|
fName := CleanupText(Value);
|
|
end;
|
|
|
|
procedure TRODLNameInfo.SetDocumentation(const Value: string);
|
|
begin
|
|
fDocumentation := CleanupTextAllowSpaces(Value);
|
|
end; }
|
|
|
|
{ TRODLEntityInfo }
|
|
|
|
{constructor TRODLEntityInfo.Create(const aName: string; const aUID: TGUID; const someDocumentation: string; aOwner:TRODLEntity);
|
|
begin
|
|
inherited Create(aName,aOwner);
|
|
|
|
UID := aUID;
|
|
Documentation := someDocumentation;
|
|
end;}
|
|
|
|
{procedure TRODLEntityInfo.Validate(iMessages:IRoPluginMessages);
|
|
//function TRODLEntityInfo.GetIsValid: boolean;
|
|
begin
|
|
//result := inherited GetIsValid and
|
|
if IsEqualGUID(UID, EmptyGUID) then
|
|
iMessages.AddMessage(rmtWarning,Name,'No UID specified',-1,Owner);
|
|
end;}
|
|
|
|
{ TRODLEntity }
|
|
|
|
constructor TRODLEntity.Create;
|
|
begin
|
|
fUID := NewGUID();
|
|
end;
|
|
|
|
destructor TRODLEntity.Destroy;
|
|
begin
|
|
if Assigned(fAttributes) then fAttributes.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TRODLEntity.GetInfo: TRODLEntity;
|
|
begin
|
|
result := self;
|
|
end;
|
|
|
|
procedure TRODLEntity.Validate(iMessages:IRoPluginMessages);
|
|
begin
|
|
if (Trim(Name) = '') then
|
|
iMessages.AddMessage(rmtError,'','No Name specified',-1,Owner);
|
|
|
|
{ ToDo: add a flag that specified whether UID is needed for the explicit base types }
|
|
if IsEqualGUID(UID, EmptyGUID) then
|
|
iMessages.AddMessage(rmtWarning,Name,'No UID specified',-1,Owner);
|
|
|
|
{result := Info.IsValid;
|
|
if not result then begin
|
|
FaultyEntity := Self;
|
|
ErrorMessage := err_InvalidInfo;
|
|
end;}
|
|
end;
|
|
|
|
function TRODLEntity.GetOwnerLibrary: TRODLLibrary;
|
|
var lOwner:TRODLEntity;
|
|
begin
|
|
lOwner := fOwner;
|
|
while Assigned(lOwner) and (not (lOwner is TRODLLibrary)) do
|
|
lOwner := lOwner.Owner;
|
|
|
|
Assert(Assigned(lOwner));
|
|
result := lOwner as TRODLLibrary;
|
|
end;
|
|
|
|
function TRODLEntity._AddRef: Integer;
|
|
begin
|
|
result := 1;
|
|
end;
|
|
|
|
function TRODLEntity._Release: Integer;
|
|
begin
|
|
result := 1;
|
|
end;
|
|
|
|
function TRODLEntity.QueryInterface(const IID: TGUID; out Obj): HRESULT;
|
|
begin
|
|
if GetInterface(IID, Obj) then
|
|
Result := 0
|
|
else
|
|
Result := E_NOINTERFACE;
|
|
end;
|
|
|
|
class function TRODLEntity.ReadableEntityTypeName: string;
|
|
begin
|
|
result := ClassName;
|
|
Delete(result,1,5); { delete the "TRODL" }
|
|
end;
|
|
|
|
function TRODLEntity.GetAttributes: TStrings;
|
|
begin
|
|
if (fAttributes = nil) then fAttributes := TStringList.Create;
|
|
result := fAttributes;
|
|
end;
|
|
|
|
procedure TRODLEntity.SetDocumentation(const Value: string);
|
|
begin
|
|
fDocumentation := Value;
|
|
end;
|
|
|
|
procedure TRODLEntity.SetName(const Value: string);
|
|
begin
|
|
fName := CleanupText(Value);
|
|
end;
|
|
|
|
{ TRODLComplexEntity }
|
|
|
|
function TRODLComplexEntity.Add(anEntity: TRODLEntity): integer;
|
|
begin
|
|
if not (anEntity is ItemClass) then RaiseError(err_InvalidType, [anEntity.ClassName, ItemClass.ClassName]);
|
|
result := fItems.Add(anEntity);
|
|
anEntity.fOwner := self;
|
|
end;
|
|
|
|
function TRODLComplexEntity.Add: TRODLEntity;
|
|
begin
|
|
result := ItemClass.Create;
|
|
result.fOwner := self;
|
|
Add(result);
|
|
end;
|
|
|
|
procedure TRODLComplexEntity.Insert(aIndex: integer; anEntity: TRODLEntity);
|
|
begin
|
|
if not (anEntity is ItemClass) then RaiseError(err_InvalidType, [anEntity.ClassName, ItemClass.ClassName]);
|
|
fItems.Insert(aIndex, anEntity);
|
|
anEntity.fOwner := self;
|
|
end;
|
|
|
|
function TRODLComplexEntity.Insert(aIndex: integer): TRODLEntity;
|
|
begin
|
|
result := ItemClass.Create;
|
|
result.fOwner := self;
|
|
Insert(aIndex, result);
|
|
end;
|
|
|
|
procedure TRODLComplexEntity.Clear;
|
|
begin
|
|
fItems.Clear;
|
|
end;
|
|
|
|
constructor TRODLComplexEntity.Create;
|
|
begin
|
|
inherited;
|
|
fAutoCreateParams := true;
|
|
fItems := TObjectList.Create;
|
|
end;
|
|
|
|
procedure TRODLComplexEntity.Delete(Index: integer);
|
|
begin
|
|
fItems.Delete(Index);
|
|
end;
|
|
|
|
destructor TRODLComplexEntity.Destroy;
|
|
begin
|
|
fItems.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TRODLComplexEntity.GetCount: integer;
|
|
begin
|
|
result := fItems.Count
|
|
end;
|
|
|
|
procedure TRODLComplexEntity.Validate(iMessages:IRoPluginMessages);
|
|
//function TRODLComplexEntity.Validate(out FaultyEntity: TRODLEntity; out ErrorMessage: string): boolean;
|
|
var
|
|
i, n: integer;
|
|
begin
|
|
inherited Validate(iMessages);
|
|
//if not result then Exit;
|
|
//result := FALSE;
|
|
|
|
// Check type names are unique
|
|
for i := 0 to (Count - 2) do
|
|
for n := i + 1 to (Count - 1) do
|
|
if (CompareText(Items[i].Info.Name, Items[n].Info.Name) = 0) then begin
|
|
|
|
iMessages.AddMessage(rmtError,Info.Name+'.'+Items[i].Info.Name,err_RodlDuplicateName,-1,Items[n]);
|
|
|
|
{FaultyEntity := ;
|
|
ErrorMessage := Format(err_DuplicateName, [Items[n].Info.Name]);
|
|
Exit;}
|
|
end;
|
|
|
|
// Check they are all valid on a basic level
|
|
for i := 0 to (Count - 1) do
|
|
Items[i].Validate(iMessages);
|
|
//if not Items[i].Validate(FaultyEntity, ErrorMessage) then Exit;
|
|
|
|
//result := TRUE;
|
|
end;
|
|
|
|
function TRODLComplexEntity.GetItems(Index: integer): TRODLEntity;
|
|
begin
|
|
result := TRODLEntity(fItems[Index]);
|
|
end;
|
|
|
|
function TRODLComplexEntity.ItemByName(const aName: string): TRODLEntity;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := nil;
|
|
|
|
for i := 0 to (Count - 1) do
|
|
if (CompareText(Items[i].Info.Name, aName) = 0) then begin
|
|
result := Items[i];
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
function TRODLComplexEntity.ItemByUID(const aUID: TGUID): TRODLEntity;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := nil;
|
|
|
|
for i := 0 to (Count - 1) do
|
|
if IsEqualGUID(Items[i].Info.UID, aUID) then begin
|
|
result := Items[i];
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLComplexEntity.Remove(anEntity: TRODLEntity);
|
|
begin
|
|
fItems.Remove(anEntity)
|
|
end;
|
|
|
|
procedure TRODLComplexEntity.Exchange(Index1, Index2: integer);
|
|
begin
|
|
fItems.Exchange(Index1, Index2);
|
|
end;
|
|
|
|
function TRODLComplexEntity.UniqueName(aBaseName: string): string;
|
|
var
|
|
i: Integer;
|
|
lIndex: Integer;
|
|
lOk: boolean;
|
|
begin
|
|
lIndex := 0;
|
|
result := aBasename;
|
|
repeat
|
|
lOk := true;
|
|
for i := 0 to Count-1 do begin
|
|
if result = Items[i].Info.Name then begin
|
|
inc(lIndex);
|
|
result := aBaseName+IntToStr(lIndex);
|
|
lOk := false;
|
|
end;
|
|
end; { for }
|
|
until lOk;
|
|
end;
|
|
|
|
function TRODLComplexEntity.ContainsEntity(aEntity: TRODLEntity; aRecurse:boolean=true): boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
result := false;
|
|
for i := 0 to Count-1 do begin
|
|
if Items[i] = aEntity then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
if aRecurse and (Items[i] is TRODLComplexEntity) then begin
|
|
result := TRODLComplexEntity(Items[i]).ContainsEntity(aEntity);
|
|
if result then exit;
|
|
end;
|
|
end; { for }
|
|
end;
|
|
|
|
function SortItem(Item1, Item2: Pointer): Integer;
|
|
begin
|
|
Result := CompareText(TRODLEntity(Item1).Name, TRODLEntity(Item2).name);
|
|
end;
|
|
|
|
procedure TRODLComplexEntity.Sort;
|
|
begin
|
|
fItems.Sort(@SortItem);
|
|
end;
|
|
|
|
{ TRODLTypedEntity }
|
|
|
|
procedure TRODLTypedEntity.Validate(iMessages:IRoPluginMessages);
|
|
begin
|
|
if (DataType = '') then begin
|
|
iMessages.AddMessage(rmtError,Owner.Owner.Info.Name+'.'+Name,err_RodlNoDataTypeSpecified,-1,Owner);
|
|
exit;
|
|
end;
|
|
|
|
if not Owner.OwnerLibrary.IsValidType(DataType) then
|
|
iMessages.AddMessage(rmtError,Owner.Owner.Info.Name+'.'+Name,Format(err_RodlInvalidDataType,[DataType]),-1,Owner);
|
|
|
|
if not (Owner is TRODLOperation) then
|
|
begin
|
|
if (CompareText(DataType,Owner.Info.Name) = 0) then
|
|
iMessages.AddMessage(rmtError,Owner.Info.Name,Format(err_RodlStructCannotBeNested,[DataType]),-1,Owner);
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLTypedEntity.SetDataType(const Value: string);
|
|
begin
|
|
fDataType := CleanupText(Value);
|
|
end;
|
|
|
|
{ TRODLStruct }
|
|
|
|
function TRODLBaseStruct.Add(aStructElement: TRODLTypedEntity): integer;
|
|
begin
|
|
result := inherited Add(aStructElement)
|
|
end;
|
|
|
|
function TRODLBaseStruct.Add: TRODLTypedEntity;
|
|
begin
|
|
result := TRODLTypedEntity(inherited Add);
|
|
result.Info.Name := 'Field' + IntToStr(Count);
|
|
end;
|
|
|
|
function CompareRODLBaseStructItems(List: TStringList; Index1, Index2: Integer): Integer;
|
|
begin
|
|
Result := CompareText(List[Index1], List[Index2]);
|
|
end;
|
|
|
|
function TRODLBaseStruct.CalcItems(aIncludeAncestors, aIgnoreDuplicates: boolean): IROStrings;
|
|
var
|
|
lAncestor, lDescendant: TRODLBaseStruct;
|
|
i: integer;
|
|
begin
|
|
result := NewROStrings();
|
|
if aIgnoreDuplicates then begin
|
|
result.Sorted := True;
|
|
result.Duplicates := dupIgnore;
|
|
end;
|
|
|
|
lAncestor := self;
|
|
repeat
|
|
for i := lAncestor.Count-1 downto 0 do
|
|
result.AddObject(lAncestor.Items[i].Name, lAncestor.Items[i]);
|
|
|
|
lDescendant := lAncestor;
|
|
if lAncestor.Ancestor <> '' then
|
|
lAncestor := OwnerLibrary.FindBaseStruct(lAncestor.Ancestor)
|
|
else
|
|
lAncestor := nil;
|
|
|
|
if assigned(lAncestor) and lAncestor.IsDerivedFrom(lDescendant) then
|
|
RaiseError(err_RodlCircularReference, [lDescendant.Name, lAncestor.Name], EROCircularReference);
|
|
|
|
until (not Assigned(lAncestor)) or (not aIncludeAncestors);
|
|
end;
|
|
|
|
function TRODLBaseStruct.CalcItemsMarshalingOrder(aIncludeAncestors: boolean=true): IROStrings;
|
|
begin
|
|
result := CalcItems(aIncludeAncestors);
|
|
|
|
// Do not use "Result.Sorted" because it uses AnsiCompareText for the comparisons
|
|
// whereas the SortPropList method originally used via GetGetPropList in TROSerializer.ReadObject
|
|
// does a case insensitive ASCII based sort. Hence the need to do our own
|
|
// sorting that calls CompareText.
|
|
result.Sorted := False;
|
|
result.CustomSort(CompareRODLBaseStructItems);
|
|
end;
|
|
|
|
function TRODLBaseStruct.GetAncestor: string;
|
|
begin
|
|
result := fAncestor;
|
|
end;
|
|
|
|
function TRODLBaseStruct.GetItemClass;
|
|
begin
|
|
result := TRODLTypedEntity;
|
|
end;
|
|
|
|
function TRODLBaseStruct.GetItems(Index: integer): TRODLTypedEntity;
|
|
begin
|
|
result := TRODLTypedEntity(inherited Items[Index]);
|
|
end;
|
|
|
|
function TRODLBaseStruct.IsDerivedFrom(aBaseStruct: TRODLBaseStruct): Boolean;
|
|
var
|
|
lAncestor: TRODLBaseStruct;
|
|
i: Integer;
|
|
begin
|
|
result := true;
|
|
lAncestor := OwnerLibrary.FindBaseStruct(Self.Ancestor);
|
|
for i := 0 to OwnerLibrary.StructCount - 1 do begin // try not more than struct count to prevent ancestor circularity
|
|
if not assigned(lAncestor) then break;
|
|
if lAncestor = aBaseStruct then exit;
|
|
lAncestor := OwnerLibrary.FindBaseStruct(lAncestor.Ancestor);
|
|
end;
|
|
result := false;
|
|
end;
|
|
|
|
procedure TRODLBaseStruct.SetAncestor(const Value: string);
|
|
begin
|
|
fAncestor := Trim(Value);
|
|
end;
|
|
|
|
procedure TRODLBaseStruct.Validate(iMessages: IRoPluginMessages);
|
|
var
|
|
lSelfItems, lAncestorItems: IROStrings;
|
|
i, j: Integer;
|
|
begin
|
|
inherited;
|
|
{ Hack: for exemptions, dont warn about missing elements }
|
|
{ ToDo: create a command base class for struct and exception, and derrive both, to avoid this kind of prob. }
|
|
if (Count = 0) and not (self is TRODLException) and (Ancestor = '') then
|
|
iMessages.AddMessage(rmtWarning, Name, err_RodlNoStructElementsDefined, -1, self);
|
|
|
|
if (Ancestor <> '') then begin
|
|
if not OwnerLibrary.IsValidType(Ancestor) and not (self is TRODLException) then begin// exceptions ancestors are checked in TRODLException.Validate
|
|
iMessages.AddMessage(rmtError, Info.Name, Format(err_RodlInvalidAncestorType, [Ancestor]), -1, self);
|
|
Exit;
|
|
end;
|
|
|
|
if assigned(OwnerLibrary.FindBaseStruct(Ancestor)) then begin
|
|
if OwnerLibrary.FindBaseStruct(Ancestor).IsDerivedFrom(Self) then begin
|
|
iMessages.AddMessage(rmtError, Info.Name, Format(err_RodlCircularReference, [Name, Ancestor]), -1, self);
|
|
Exit;
|
|
end;
|
|
|
|
try
|
|
lSelfItems := CalcItems(False, False);
|
|
lAncestorItems := OwnerLibrary.FindBaseStruct(Ancestor).CalcItems(True, False);
|
|
for i := 0 to lSelfItems.Count - 1 do
|
|
for j := 0 to lAncestorItems.Count - 1 do
|
|
if CompareText(lSelfItems[i], lAncestorItems[j]) = 0 then
|
|
iMessages.AddMessage(rmtError, Name+'.'+lSelfItems[i], Format(err_RodlItemExistsInAnsector, [lSelfItems[i], TRODLEntity(lAncestorItems.Objects[j]).Owner.Name]), -1, Self);
|
|
except
|
|
on EROCircularReference do
|
|
iMessages.AddMessage(rmtWarning, Name, err_RodlCircularityWarning, -1, Self);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TRODLEnum }
|
|
|
|
function TRODLEnum.Add(aStructElement: TRODLEnumValue): integer;
|
|
begin
|
|
result := inherited Add(aStructElement)
|
|
end;
|
|
|
|
function TRODLEnum.Add: TRODLEnumValue;
|
|
begin
|
|
result := TRODLEnumValue(inherited Add);
|
|
result.Info.Name := 'Value' + IntToSTr(Count);
|
|
end;
|
|
|
|
constructor TRODLEnum.Create;
|
|
begin
|
|
inherited;
|
|
fPrefixEnumValues := True;
|
|
end;
|
|
|
|
function TRODLEnum.GetItemClass: TRODLEntityClass;
|
|
begin
|
|
result := TRODLEnumValue;
|
|
end;
|
|
|
|
function TRODLEnum.GetItems(Index: integer): TRODLEnumValue;
|
|
begin
|
|
result := TRODLEnumValue(inherited Items[Index]);
|
|
end;
|
|
|
|
procedure TRODLEnum.Validate(iMessages: IRoPluginMessages);
|
|
begin
|
|
inherited;
|
|
if Count = 0 then
|
|
iMessages.AddMessage(rmtError,Info.Name,err_RodlNoEnumValues,-1,self);
|
|
end;
|
|
|
|
{ TRODLBaseService }
|
|
|
|
function TRODLBaseService.Add(aServiceInterface: TRODLServiceInterface): integer;
|
|
begin
|
|
result := inherited Add(aServiceInterface);
|
|
end;
|
|
|
|
function TRODLBaseService.Add: TRODLServiceInterface;
|
|
begin
|
|
result := TRODLServiceInterface(inherited Add);
|
|
end;
|
|
|
|
constructor TRODLBaseService.Create;
|
|
var
|
|
defintf: TRODLServiceInterface;
|
|
begin
|
|
inherited;
|
|
fisPrivate := False;
|
|
defintf := Add;
|
|
defintf.Info.Name := DefaultIntfName;
|
|
defintf.Info.UID := NewGUID;
|
|
end;
|
|
|
|
function TRODLBaseService.GetAncestor: string;
|
|
begin
|
|
result := fAncestor;
|
|
end;
|
|
|
|
function TRODLBaseService.GetDefault: TRODLServiceInterface;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := nil;
|
|
if (Count = 1) then
|
|
result := Items[0]
|
|
else
|
|
for i := 0 to (Count - 1) do
|
|
if (CompareText(Items[i].Info.name, DefaultIntfName) = 0) then begin
|
|
result := Items[i];
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
function TRODLBaseService.GetItemClass: TRODLEntityClass;
|
|
begin
|
|
result := TRODLServiceInterface;
|
|
end;
|
|
|
|
function TRODLBaseService.GetItems(Index: integer): TRODLServiceInterface;
|
|
begin
|
|
result := TRODLServiceInterface(inherited Items[Index]);
|
|
end;
|
|
|
|
function TRODLBaseService.IsDerivedFrom(aBaseService: TRODLBaseService): Boolean;
|
|
var
|
|
lAncestor: TRODLBaseService;
|
|
i: Integer;
|
|
begin
|
|
result := true;
|
|
lAncestor := OwnerLibrary.FindBaseService(Self.Ancestor);
|
|
for i := 0 to OwnerLibrary.ServiceCount - 1 do begin // try not more than service count to prevent ancestor circularity
|
|
if not assigned(lAncestor) then break;
|
|
if lAncestor = aBaseService then exit;
|
|
lAncestor := OwnerLibrary.FindBaseService(lAncestor.Ancestor);
|
|
end;
|
|
result := false;
|
|
end;
|
|
|
|
procedure TRODLBaseService.SetAncestor(const Value: string);
|
|
begin
|
|
fAncestor := Trim(Value);
|
|
end;
|
|
|
|
procedure TRODLBaseService.Validate(iMessages: IRoPluginMessages);
|
|
var
|
|
lSelfItems, lAncestorItems: IROStrings;
|
|
i, j: Integer;
|
|
begin
|
|
inherited;
|
|
for i := 0 to Count-1 do begin
|
|
//Items[i].Validate(iMessages);
|
|
if (Items[i].Count = 0) and (Ancestor = '') then
|
|
iMessages.AddMessage(rmtWarning, Name+'.'+Items[i].Name, err_RodlNoOperationsDefined, -1, self);
|
|
end;
|
|
|
|
if (Ancestor <> '') then begin
|
|
if self is TRODLEventSink then begin
|
|
if not OwnerLibrary.IsValidEventSink(Ancestor) then begin
|
|
iMessages.AddMessage(rmtError, Name, Format(err_RodlInvalidAncestorType, [Ancestor]),-1, self);
|
|
Exit;
|
|
end;
|
|
end else begin
|
|
if not OwnerLibrary.IsValidService(Ancestor) then begin
|
|
iMessages.AddMessage(rmtError, Name, Format(err_RodlInvalidAncestorType, [Ancestor]),-1, self);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
if assigned(OwnerLibrary.FindBaseService(Ancestor)) then begin
|
|
if OwnerLibrary.FindBaseService(Ancestor).IsDerivedFrom(Self) then begin
|
|
iMessages.AddMessage(rmtError, Info.Name, Format(err_RodlCircularReference, [Name, Ancestor]), -1, self);
|
|
Exit;
|
|
end;
|
|
|
|
try
|
|
lSelfItems := Default.CalcItems(False, False);
|
|
lAncestorItems := OwnerLibrary.FindBaseService(Ancestor).Default.CalcItems(True, False);
|
|
for i := 0 to lSelfItems.Count - 1 do
|
|
for j := 0 to lAncestorItems.Count - 1 do
|
|
if CompareText(lSelfItems[i], lAncestorItems[j]) = 0 then
|
|
iMessages.AddMessage(rmtError, Name+'.'+lSelfItems[i], Format(err_RodlItemExistsInAnsector, [lSelfItems[i], TRODLEntity(lAncestorItems.Objects[j]).Owner.Owner.Name]), -1, Self);
|
|
except
|
|
on EROCircularReference do
|
|
iMessages.AddMessage(rmtWarning, Name, err_RodlCircularityWarning, -1, Self);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TRODLOperationParam }
|
|
|
|
{constructor TRODLOperationParam.Create(const aName, aTypeName: string; aFlag: TRODLParamFlag; aOwner:TRODLEntity);
|
|
begin
|
|
inherited Create(aName, aTypeName, aOwner);
|
|
Flag := aFlag;
|
|
end;}
|
|
|
|
function TRODLOperationParam.GetFlag: string;
|
|
begin
|
|
result := RODLParamFlagNames[fFlag];
|
|
end;
|
|
|
|
procedure TRODLOperationParam.SetFlag(const aValue: string);
|
|
var
|
|
lFlag: TRODLParamFlag;
|
|
begin
|
|
for lFlag := Low(TRODLParamFlag) to High(TRODLParamFlag) do
|
|
if SameText(RODLParamFlagNames[lFlag], aValue) then begin
|
|
fFlag := lFlag;
|
|
exit;
|
|
end;
|
|
RaiseError(err_InvalidParamFlag, [aValue]);
|
|
end;
|
|
|
|
{ TRODLOperation }
|
|
|
|
function TRODLOperation.Add(aParam: TRODLOperationParam): integer;
|
|
begin
|
|
if aParam.fFlag = fResult then
|
|
RaiseError(err_MayNotAddResult);
|
|
|
|
result := inherited Add(aParam)
|
|
end;
|
|
|
|
function TRODLOperation.Add: TRODLOperationParam;
|
|
begin
|
|
result := TRODLOperationParam(inherited Add);
|
|
result.Info.Name := 'Param' + IntToStr(Count);
|
|
end;
|
|
|
|
function TRODLOperation.GetItemClass: TRODLEntityClass;
|
|
begin
|
|
result := TRODLOperationParam;
|
|
end;
|
|
|
|
function TRODLOperation.GetItems(Index: integer): TRODLOperationParam;
|
|
begin
|
|
result := TRODLOperationParam(inherited Items[Index]);
|
|
end;
|
|
|
|
function TRODLOperation.GetResult: TRODLOperationParam;
|
|
{var
|
|
i: integer;}
|
|
begin
|
|
result := fOperationResult;
|
|
{result := nil;
|
|
for i := 0 to (Count - 1) do
|
|
if (Items[i].Info.Flag = fResult) then begin
|
|
result := Items[i];
|
|
Exit;
|
|
end;}
|
|
end;
|
|
|
|
{ Makes sure the Result patrameter is always at the top of the list, so it
|
|
doesn't get in the way of sorting methods. }
|
|
|
|
{procedure TRODLOperation.MoveResult;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to (Count - 1) do
|
|
if (Items[i].Info.Flag = fResult) then begin
|
|
if i <> 0 then fItems.Move(i,0);
|
|
Exit;
|
|
end;
|
|
end;}
|
|
|
|
|
|
function TRODLOperation.GetCodeBody(iLanguage: string): TStrings;
|
|
var
|
|
lIndex:integer;
|
|
begin
|
|
result := nil;
|
|
|
|
lIndex := fCodeBodies.IndexOf(iLanguage);
|
|
if lIndex > -1 then result := fCodeBodies.Objects[lIndex] as TStrings
|
|
end;
|
|
|
|
procedure TRODLOperation.SetCodeBody(iLanguage: string; Value: TStrings);
|
|
var
|
|
lStrings:TStrings;
|
|
lIndex:integer;
|
|
begin
|
|
if Assigned(Value) then begin
|
|
lStrings := GetCodeBody(iLanguage);
|
|
if not Assigned(lStrings) then begin
|
|
lStrings := TStringList.Create();
|
|
fCodeBodies.AddObject(Lowercase(iLanguage),lStrings);
|
|
end;
|
|
lStrings.Assign(Value);
|
|
end
|
|
else begin
|
|
lIndex := fCodeBodies.IndexOf(iLanguage);
|
|
if lIndex > 0 then fCodeBodies.Delete(lIndex);
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLOperation.SetCodeBodyAsString(iLanguage: string; const Value: string);
|
|
var
|
|
lStrings:TStrings;
|
|
lIndex:integer;
|
|
begin
|
|
if Value <> '' then begin
|
|
lStrings := GetCodeBody(iLanguage);
|
|
if not Assigned(lStrings) then begin
|
|
lStrings := TStringList.Create();
|
|
fCodeBodies.AddObject(Lowercase(iLanguage),lStrings);
|
|
end;
|
|
lStrings.Text := Value;
|
|
end
|
|
else begin
|
|
lIndex := fCodeBodies.IndexOf(iLanguage);
|
|
if lIndex > 0 then fCodeBodies.Delete(lIndex);
|
|
end;
|
|
end;
|
|
|
|
constructor TRODLOperation.Create;
|
|
begin
|
|
inherited;
|
|
fCodeBodies := TStringList.Create();
|
|
fCodeBodies.Sorted := true;
|
|
fCodeBodies.Duplicates := dupError;
|
|
end;
|
|
|
|
destructor TRODLOperation.Destroy;
|
|
var i:integer;
|
|
begin
|
|
RemoveResult;
|
|
for i := 0 to fCodeBodies.Count-1 do fCodeBodies.Objects[i].Free();
|
|
FreeAndNil(fCodeBodies);
|
|
inherited;
|
|
end;
|
|
|
|
function TRODLOperation.GetCodeBodyCount: integer;
|
|
begin
|
|
result := fCodeBodies.Count;
|
|
end;
|
|
|
|
function TRODLOperation.GetCodeBodyLanguages(iIndex: integer): string;
|
|
begin
|
|
result := fCodeBodies[iIndex];
|
|
end;
|
|
|
|
{procedure TRODLOperation.Exchange(Index1, Index2: integer);
|
|
begin
|
|
MoveResult();
|
|
if Assigned(GetResult()) then begin
|
|
inc(Index1);
|
|
inc(Index2);
|
|
end;
|
|
inherited Exchange(Index1, Index2);
|
|
end;}
|
|
|
|
function TRODLOperation.AddResult: TRODLOperationParam;
|
|
begin
|
|
if not Assigned(fOperationResult) then begin
|
|
fOperationResult := TRODLOperationParam.Create;
|
|
fOperationResult.fOwner := self;
|
|
fOperationResult.Flag := fResult;
|
|
fOperationResult.Name := 'Result';
|
|
end;
|
|
result := fOperationResult;
|
|
end;
|
|
|
|
procedure TRODLOperation.RemoveResult;
|
|
begin
|
|
if Assigned(fOperationResult) then
|
|
FreeAndNil(fOperationResult);
|
|
end;
|
|
|
|
function TRODLOperation.GetParameter(const aParameterName: string): TRODLOperationParam;
|
|
begin
|
|
result := TRODLOperationParam(ItemByName(aParameterName));
|
|
if result=NIL then raise EROUnknownItem.CreateFmt('Cannot find parameter %s', [aParameterName]);
|
|
end;
|
|
|
|
procedure TRODLOperation.Validate(iMessages: IROPluginMessages);
|
|
begin
|
|
inherited;
|
|
if (Result <> nil) and (Result.DataType <> '') then begin
|
|
if not Owner.OwnerLibrary.IsValidType(Result.DataType) then
|
|
iMessages.AddMessage(rmtError,Info.Name+'.'+Name,Format(err_RodlInvalidDataType,[Result.DataType]),-1,Self);
|
|
end;
|
|
end;
|
|
|
|
{ TRODLServiceInterface }
|
|
|
|
function TRODLServiceInterface.Add(aParam: TRODLOperation): integer;
|
|
begin
|
|
result := inherited Add(aParam)
|
|
end;
|
|
|
|
function TRODLServiceInterface.Add: TRODLOperation;
|
|
begin
|
|
result := TRODLOperation(inherited Add);
|
|
result.Info.Name := 'Operation' + IntToStr(Count);
|
|
result.Info.UID := NewGUID;
|
|
end;
|
|
|
|
function TRODLServiceInterface.GetOperation(
|
|
const anOperationName: string;
|
|
IncludeAnchestors : boolean = FALSE) : TRODLOperation;
|
|
begin
|
|
result := FindOperation(anOperationName, IncludeAnchestors);
|
|
if (result=NIL) then raise EROUnknownItem.CreateFmt('Cannot find operation %s', [anOperationName]);
|
|
end;
|
|
|
|
procedure TRODLServiceInterface.GetOperationsList(AList: TList);
|
|
var svc : TRODLService;
|
|
i: Integer;
|
|
lib : TRODLLibrary;
|
|
begin
|
|
AList.Clear;
|
|
|
|
For i:=0 to Count-1 do
|
|
AList.Add(Items[i]);
|
|
|
|
lib := info.Owner.OwnerLibrary;
|
|
svc := lib.FindService((Owner as TRODLService).Info.Name);
|
|
|
|
while TRUE do begin
|
|
if (svc.Ancestor='') then Break;
|
|
|
|
svc := lib.GetService(svc.Ancestor);
|
|
|
|
For i:=0 to svc.Count-1 do
|
|
AList.Add(svc.Default.Items[i]);
|
|
end;
|
|
end;
|
|
|
|
function TRODLServiceInterface.GetItemClass: TRODLEntityClass;
|
|
begin
|
|
result := TRODLOperation;
|
|
end;
|
|
|
|
function TRODLServiceInterface.GetItems(Index: integer): TRODLOperation;
|
|
begin
|
|
result := TRODLOperation(inherited Items[Index]);
|
|
end;
|
|
|
|
function TRODLServiceInterface.FindOperation(const anOperationName : string; IncludeAnchestors : boolean = FALSE) : TRODLOperation;
|
|
var svc : TRODLService;
|
|
i: Integer;
|
|
lib : TRODLLibrary;
|
|
begin
|
|
result := NIL;
|
|
for i := 0 to (Count-1) do
|
|
if SameText(anOperationName, Items[i].Info.Name) then begin
|
|
result := Items[i];
|
|
Exit;
|
|
end;
|
|
|
|
if (result=NIL) and IncludeAnchestors then begin
|
|
lib := info.Owner.OwnerLibrary;
|
|
//intf := TRODLServiceInterface;
|
|
svc := lib.FindService((Owner as TRODLService).Info.Name);
|
|
|
|
while TRUE do begin
|
|
if (svc.Ancestor='') then Break;
|
|
|
|
svc := lib.GetService(svc.Ancestor);
|
|
result := svc.Default.FindOperation(anOperationName);
|
|
|
|
if (result<>NIL) then Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRODLServiceInterface.CalcItems(aIncludeAncestors, aIgnoreDuplicates: boolean): IROStrings;
|
|
var
|
|
lAncestor, lDescendant: TRODLBaseService;
|
|
i: integer;
|
|
begin
|
|
result := NewROStrings();
|
|
if aIgnoreDuplicates then begin
|
|
result.Sorted := True;
|
|
result.Duplicates := dupIgnore;
|
|
end;
|
|
|
|
lAncestor := self.Owner as TRODLBaseService;
|
|
repeat
|
|
for i := lAncestor.Default.Count-1 downto 0 do
|
|
result.AddObject(lAncestor.Default.Items[i].Name, lAncestor.Default.Items[i]);
|
|
|
|
lDescendant := lAncestor;
|
|
if lAncestor.Ancestor <> '' then
|
|
lAncestor := OwnerLibrary.FindService(lAncestor.Ancestor)
|
|
else
|
|
lAncestor := nil;
|
|
|
|
if aIncludeAncestors and aIncludeAncestors and assigned(lAncestor) and lAncestor.IsDerivedFrom(lDescendant) then
|
|
RaiseError(err_RodlCircularReference, [lDescendant.Name, lAncestor.Name], EROCircularReference);
|
|
|
|
until (not Assigned(lAncestor)) or (not aIncludeAncestors);
|
|
end;
|
|
|
|
{ TRODLLibrary }
|
|
|
|
function TRODLLibrary.Add(anEntity: TRODLEntity): integer;
|
|
begin
|
|
if (anEntity is TRODLArray) then
|
|
Inc(fArrayCount)
|
|
else if (anEntity is TRODLEnum) then
|
|
Inc(fEnumCount)
|
|
else if (anEntity is TRODLStruct) then
|
|
Inc(fStructCount)
|
|
else if (anEntity is TRODLService) then
|
|
Inc(fServiceCount)
|
|
else if (anEntity is TRODLUse) then
|
|
Inc(fUseCount)
|
|
else if (anEntity is TRODLException) then
|
|
Inc(fExceptionCount)
|
|
else if (anEntity is TRODLEventSink) then
|
|
Inc(fEventSinkCount)
|
|
else if (anEntity is TRODLGroup) then
|
|
Inc(fGroupCount);
|
|
|
|
result := inherited Add(anEntity);
|
|
end;
|
|
|
|
function TRODLLibrary.GetItemClass: TRODLEntityClass;
|
|
begin
|
|
result := TRODLEntity;
|
|
end;
|
|
|
|
procedure TRODLLibrary.Remove(anEntity: TRODLEntity);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if (anEntity is TRODLGroup) then begin
|
|
for i := 0 to Count-1 do
|
|
if Items[i].GroupUnder = anEntity then
|
|
Items[i].GroupUnder := anEntity.GroupUnder;
|
|
end
|
|
else if (anEntity is TRODLUse) then begin
|
|
for i := Count-1 downto 0 do
|
|
if Items[i].LocatedInRodlUse = anEntity then
|
|
Remove(Items[i]);
|
|
end;
|
|
|
|
if (anEntity is TRODLArray) then
|
|
Dec(fArrayCount)
|
|
else if (anEntity is TRODLEnum) then
|
|
Dec(fEnumCount)
|
|
else if (anEntity is TRODLStruct) then
|
|
Dec(fStructCount)
|
|
else if (anEntity is TRODLService) then
|
|
Dec(fServiceCount)
|
|
else if (anEntity is TRODLUse) then
|
|
Dec(fUseCount)
|
|
else if (anEntity is TRODLException) then
|
|
Dec(fExceptionCount)
|
|
else if (anEntity is TRODLEventSink) then
|
|
Dec(fEventSinkCount)
|
|
else if (anEntity is TRODLGroup) then
|
|
Dec(fGroupCount);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TRODLLibrary.Delete(Index: integer);
|
|
var
|
|
item: TRODLEntity;
|
|
begin
|
|
item := Items[Index];
|
|
Remove(item);
|
|
inherited Delete(Index);
|
|
end;
|
|
|
|
function TRODLLibrary.GetArray(Index: integer): TRODLArray;
|
|
begin
|
|
if (Index > ArrayCount - 1) then RaiseError(err_InvalidIndex, [Index]);
|
|
result := GetByType(Index,TRODLArray) as TRODLArray;
|
|
end;
|
|
|
|
function TRODLLibrary.GetEnums(Index: integer): TRODLEnum;
|
|
begin
|
|
if (Index > EnumCount - 1) then RaiseError(err_InvalidIndex, [Index]);
|
|
result := GetByType(Index,TRODLEnum) as TRODLEnum;
|
|
end;
|
|
|
|
function TRODLLibrary.GetServices(Index: integer): TRODLService;
|
|
begin
|
|
if (Index > ServiceCount - 1) then RaiseError(err_InvalidIndex, [Index]);
|
|
result := GetByType(Index,TRODLService) as TRODLService;
|
|
end;
|
|
|
|
function TRODLLibrary.GetStructs(Index: integer): TRODLStruct;
|
|
begin
|
|
if (Index > StructCount - 1) then RaiseError(err_InvalidIndex, [Index]);
|
|
result := GetByType(Index,TRODLStruct) as TRODLStruct;
|
|
end;
|
|
|
|
function TRODLLibrary.GetExceptions(Index: integer): TRODLException;
|
|
begin
|
|
if (Index > ExceptionCount - 1) then RaiseError(err_InvalidIndex, [Index]);
|
|
result := GetByType(Index,TRODLException) as TRODLException;
|
|
end;
|
|
|
|
function TRODLLibrary.GetUse(Index: integer): TRODLUse;
|
|
begin
|
|
if (Index > UseCount - 1) then RaiseError(err_InvalidIndex, [Index]);
|
|
result := GetByType(Index,TRODLUse) as TRODLUse;
|
|
end;
|
|
|
|
function TRODLLibrary.GetGroups(Index: integer): TRODLGroup;
|
|
begin
|
|
if (Index > GroupCount - 1) then RaiseError(err_InvalidIndex, [Index]);
|
|
result := GetByType(Index,TRODLGroup) as TRODLGroup;
|
|
end;
|
|
|
|
function TRODLLibrary.GetEventSinks(Index: integer): TRODLEventSink;
|
|
begin
|
|
if (Index > EventSinkCount - 1) then RaiseError(err_InvalidIndex, [Index]);
|
|
result := GetByType(Index,TRODLEventSink) as TRODLEventSink;
|
|
end;
|
|
|
|
function TRODLLibrary.GetByType(aIndex:integer; aType:TRODLEntityClass):TRODLEntity;
|
|
var
|
|
i, c: integer;
|
|
begin
|
|
result := nil;
|
|
if (aIndex < 0) then RaiseError(err_InvalidIndex, [aIndex]);
|
|
|
|
c := -1;
|
|
for i := 0 to (Count - 1) do begin
|
|
if (Items[i] is aType) then Inc(c);
|
|
if (c = aIndex) then begin
|
|
result := Items[i];
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
constructor TRODLLibrary.Create;
|
|
begin
|
|
inherited;
|
|
Info.Name := 'NewLibrary';
|
|
Info.UID := NewGUID;
|
|
end;
|
|
|
|
function TRODLLibrary.IsValidCustomType(const iTypeName: string): boolean;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := false;
|
|
for i := 0 to ArrayCount-1 do begin
|
|
if CompareText(Arrays[i].Info.Name,iTypeName) = 0 then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
end;
|
|
for i := 0 to StructCount-1 do begin
|
|
if CompareText(Structs[i].Info.Name,iTypeName) = 0 then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
end;
|
|
for i := 0 to EnumCount-1 do begin
|
|
if CompareText(Enums[i].Info.Name,iTypeName) = 0 then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRODLLibrary.IsValidSimpleType(const iTypeName: string): boolean;
|
|
var
|
|
d:TRODataType;
|
|
i: Integer;
|
|
begin
|
|
result := false;
|
|
for d := Low(TRODataType) to High(TRODataType) do begin
|
|
if (not (d in [rtUserDefined])) and
|
|
(CompareText(DataTypeNames[d],iTypeName) = 0) then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
end;
|
|
for i := Low(DataTypeRemapping) to High(DataTypeRemapping) do begin
|
|
if CompareText(DataTypeRemapping[i].Name, iTypeName) = 0 then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TRODLLibrary.IsValidType(const iTypeName: string): boolean;
|
|
begin
|
|
result := IsValidCustomType(iTypeName) or IsValidSimpleType(iTypeName);
|
|
end;
|
|
|
|
function TRODLLibrary.FindStruct(const iStructName: string): TRODLStruct;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := nil;
|
|
for i := 0 to StructCount-1 do begin
|
|
if CompareText(Structs[i].Info.Name,iStructName) = 0 then begin
|
|
result := Structs[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRODLLibrary.FindBaseStruct(const iStructName: string): TRODLBaseStruct;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := nil;
|
|
for i := 0 to Count-1 do begin
|
|
if (Items[i] is TRODLBaseStruct) and (CompareText(Items[i].Info.Name,iStructName) = 0) then begin
|
|
result := Items[i] as TRODLBaseStruct;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TRODLLibrary.FindEnum(const iEnumName: string): TRODLEnum;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := nil;
|
|
for i := 0 to EnumCount-1 do begin
|
|
if CompareText(Enums[i].Info.Name,iEnumName) = 0 then begin
|
|
result := Enums[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRODLLibrary.FindArray(const iArrayName: string): TRODLArray;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := nil;
|
|
for i := 0 to ArrayCount-1 do begin
|
|
if CompareText(Arrays[i].Info.Name,iArrayName) = 0 then begin
|
|
result := Arrays[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRODLLibrary.FindGroup(const aID: TGUID): TRODLGroup;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := nil;
|
|
for i := 0 to GroupCount-1 do begin
|
|
if IsEqualGUID(Groups[i].UID,aID) then begin
|
|
result := Groups[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TRODLLibrary.IsValidService(const iServiceName: string): boolean;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := false;
|
|
for i := 0 to ServiceCount-1 do begin
|
|
if CompareText(Services[i].Info.Name,iServiceName) = 0 then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TRODLLibrary.FindBaseService(const iServiceName: string): TRODLBaseService;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := nil;
|
|
for i := 0 to Count-1 do begin
|
|
if (Items[i] is TRODLBaseService) and (CompareText(Items[i].Info.Name,iServiceName) = 0) then begin
|
|
result := Items[i] as TRODLBaseService;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRODLLibrary.FindService(const iServiceName: string):TRODLService;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := nil;
|
|
for i := 0 to ServiceCount-1 do begin
|
|
if CompareText(Services[i].Info.Name,iServiceName) = 0 then begin
|
|
result := Services[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRODLLibrary.FindException(const iExceptionName: string):TRODLException;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := nil;
|
|
for i := 0 to ExceptionCount-1 do begin
|
|
if CompareText(Exceptions[i].Info.Name,iExceptionName) = 0 then begin
|
|
result := Exceptions[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRODLLibrary.FindUse(const iUseName: string):TRODLUse;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := nil;
|
|
for i := 0 to fUseCount-1 do begin
|
|
if CompareText(Use[i].Info.Name,iUseName) = 0 then begin
|
|
result := Use[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRODLLibrary.FindUseByFilename(const iUseRODLFile: string):TRODLUse;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := nil;
|
|
for i := 0 to fUseCount-1 do begin
|
|
if CompareText(Use[i].RodlFile, iUseRODLFile) = 0 then begin
|
|
result := Use[i];
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRODLLibrary.IsValidException(const iTypeName:string):boolean;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := false;
|
|
for i := 0 to ExceptionCount-1 do begin
|
|
if CompareText(Exceptions[i].Info.Name,iTypeName) = 0 then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRODLLibrary.CalcServiceOrder: IROStrings;
|
|
var
|
|
lEntities:IROStrings;
|
|
i:integer;
|
|
begin
|
|
lEntities := NewROStrings();
|
|
for i := ServiceCount-1 downto 0 do begin
|
|
if not Services[i].IsFromUsedRodl then
|
|
lEntities.AddObject(Services[i].Info.Name,Services[i])
|
|
end;
|
|
result := CalcOrder(lEntities);
|
|
end;
|
|
|
|
function TRODLLibrary.CalcEventSinkOrder: IROStrings;
|
|
var
|
|
lEntities:IROStrings;
|
|
i:integer;
|
|
begin
|
|
lEntities := NewROStrings();
|
|
for i := EventSinkCount-1 downto 0 do begin
|
|
if not EventSinks[i].IsFromUsedRodl then
|
|
lEntities.AddObject(EventSinks[i].Info.Name,EventSinks[i])
|
|
end;
|
|
result := CalcOrder(lEntities);
|
|
end;
|
|
|
|
function TRODLLibrary.CalcStructOrder: IROStrings;
|
|
var
|
|
lEntities:IROStrings;
|
|
i:integer;
|
|
begin
|
|
lEntities := NewROStrings();
|
|
for i := StructCount-1 downto 0 do begin
|
|
if not Structs[i].IsFromUsedRodl then
|
|
lEntities.AddObject(Structs[i].Info.Name,Structs[i])
|
|
end;
|
|
result := CalcOrder(lEntities);
|
|
end;
|
|
|
|
function TRODLLibrary.CalcExceptionOrder: IROStrings;
|
|
var
|
|
lEntities:IROStrings;
|
|
i:integer;
|
|
begin
|
|
lEntities := NewROStrings();
|
|
for i := ExceptionCount-1 downto 0 do begin
|
|
if not Exceptions[i].IsFromUsedRodl then
|
|
lEntities.AddObject(Exceptions[i].Info.Name,Exceptions[i])
|
|
end;
|
|
result := CalcOrder(lEntities);
|
|
end;
|
|
|
|
function TRODLLibrary.CalcOrder(const iObjects:IROStrings):IROStrings;
|
|
var
|
|
lAncestors:IROStrings;
|
|
i,lIndex:integer;
|
|
lEntity:TRODLEntity;
|
|
lWorked:boolean;
|
|
begin
|
|
lAncestors := NewROStrings();
|
|
result := NewROStrings();
|
|
|
|
for i := 0 to iObjects.Count-1 do begin
|
|
lEntity := iObjects.Objects[i] as TRODLEntity;
|
|
lAncestors.AddObject((lEntity as IRODLEntityWithAncestor).Ancestor,lEntity)
|
|
end;
|
|
|
|
for i := lAncestors.Count-1 downto 0 do begin
|
|
if lAncestors[i] <> '' then lIndex := iObjects.IndexOf(lAncestors[i]) else lIndex := -1; { else needed to keep the warning away only }
|
|
if (lAncestors[i] = '') or (lIndex = -1) then begin
|
|
result.AddObject((lAncestors.Objects[i] as TRODLEntity).Info.Name,lAncestors.Objects[i]);
|
|
lAncestors.Delete(i);
|
|
end;
|
|
end;
|
|
|
|
while lAncestors.Count > 0 do begin
|
|
lWorked := false;
|
|
for i := lAncestors.Count-1 downto 0 do begin
|
|
lIndex := result.IndexOf(lAncestors[i]);
|
|
if (lIndex > -1) then begin
|
|
result.InsertObject(lIndex+1,(lAncestors.Objects[i] as TRODLEntity).Info.Name,lAncestors.Objects[i]);
|
|
lAncestors.Delete(i);
|
|
lWorked := true;
|
|
end;
|
|
end;
|
|
if (not lWorked) and (lAncestors.Count > 0) then
|
|
RaiseError('Invalid or recursive inheritance for the following entities: '+lAncestors.Text);
|
|
end;
|
|
end;
|
|
|
|
function TRODLLibrary.GetService(const aServiceName: string): TRODLService;
|
|
begin
|
|
result := FindService(aServiceName);
|
|
if result=NIL then raise EROUnknownItem.CreateFmt('Cannot find service %s', [aServiceName])
|
|
end;
|
|
|
|
function TRODLLibrary.GetStruct(const aStructName: string): TRODLStruct;
|
|
begin
|
|
result := FindStruct(aStructName);
|
|
if result=NIL then raise EROUnknownItem.CreateFmt('Cannot find struct %s', [aStructName])
|
|
end;
|
|
|
|
procedure TRODLLibrary.ClearDuplicates;
|
|
var
|
|
lID: string;
|
|
lItem: TRODLEntity;
|
|
lIDs: TStringList;
|
|
i: Integer;
|
|
const
|
|
EMPTY_GUID = '{00000000-0000-0000-0000-000000000000}';
|
|
begin
|
|
lIDs := TStringList.Create();
|
|
try
|
|
lIDs.Duplicates := dupError;
|
|
lIDs.Sorted := true;
|
|
for i := Count-1 downto 0 do begin
|
|
lItem := Items[i];
|
|
|
|
if (lItem is TRODLUse) then continue; { removing duplicate uses would blow up the order; and they do no harm anyway }
|
|
lID := GUIDToString(lItem.UID);
|
|
if SameText(lID, EMPTY_GUID) then continue;
|
|
|
|
if (lIDs.IndexOf(lID) > -1) and (not SameText(lID, EMPTY_GUID)) then begin
|
|
{$IFDEF DEBUG_REMOBJECTS_RODL}
|
|
DebugServer.Write('Removing duplicate %s %s (%s)',[lItem.ReadableEntityTypeName, lItem.Name, lID]);
|
|
{$ENDIF}
|
|
Remove(lItem);
|
|
end
|
|
else begin
|
|
lIDs.Add(lID);
|
|
end;
|
|
end; { for }
|
|
finally
|
|
lIDs.Free();
|
|
end;
|
|
end;
|
|
|
|
procedure TRODLLibrary.GetArraysByElement(const aElementName: string;
|
|
AList: TList);
|
|
var
|
|
i: integer;
|
|
begin
|
|
AList.Clear;
|
|
for i := 0 to ArrayCount-1 do
|
|
if CompareText(Arrays[i].ElementType,aElementName) = 0 then
|
|
AList.Add(Arrays[i]);
|
|
end;
|
|
|
|
function TRODLLibrary.IsValidEventSink(
|
|
const iEventSink: string): boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := false;
|
|
|
|
for i := 0 to EventSinkCount-1 do begin
|
|
if CompareText(EventSinks[i].Info.Name,iEventsink) = 0 then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TRODLArray }
|
|
|
|
procedure TRODLArray.SetElementType(const Value: string);
|
|
begin
|
|
fElementType := Trim(Value);
|
|
end;
|
|
|
|
procedure TRODLArray.Validate(iMessages:IRoPluginMessages);
|
|
//function TRODLArray.Validate(out FaultyEntity: TRODLEntity; out ErrorMessage: string): boolean;
|
|
begin
|
|
inherited;
|
|
if (ElementType = '') then
|
|
iMessages.AddMessage(rmtError,Info.Name,err_RodlNoDataTypeSpecified,-1,self);
|
|
|
|
if (ElementType <> '') and not OwnerLibrary.IsValidType(ElementType) then
|
|
iMessages.AddMessage(rmtError,Info.Name,Format(err_RodlInvalidDataType,[ElementType]),-1,Owner);
|
|
end;
|
|
|
|
{ TRODLConverter }
|
|
|
|
constructor TRODLConverter.Create(const aLibraryFile: string; const aTargetEntity: string = '');
|
|
var
|
|
lLibrary: TRODLLibrary;
|
|
begin
|
|
with TXMLToRODL.Create(nil) do try
|
|
lLibrary := ReadFromFile(aLibraryFile);
|
|
try
|
|
Self.Create(lLibrary, aTargetEntity);
|
|
finally
|
|
FreeAndNil(lLibrary);
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
constructor TRODLConverter.Create(const aLibrary: TRODLLibrary; const aTargetEntity: string = '');
|
|
begin
|
|
inherited Create;
|
|
|
|
fBuffer := TStringList.Create;
|
|
if (aLibrary <> nil) then Convert(aLibrary, aTargetEntity);
|
|
end;
|
|
|
|
destructor TRODLConverter.Destroy;
|
|
begin
|
|
fBuffer.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TRODLConverter.Convert(const aLibrary: TRODLLibrary; const aTargetEntity: string = '');
|
|
begin
|
|
if (aLibrary = nil) then
|
|
RaiseError(err_InvalidLibrary, [])
|
|
else if (aTargetEntity<>'') and not ValidateTargetEntity(aLibrary, aTargetEntity) then
|
|
RaiseError(err_InvalidTargetEntity, [aTargetEntity]);
|
|
|
|
fTargetEntity := aTargetEntity;
|
|
|
|
fBuffer.Clear;
|
|
IntConvert(aLibrary, aTargetEntity);
|
|
end;
|
|
|
|
function TRODLConverter.GetBuffer: TStrings;
|
|
begin
|
|
result := fBuffer as TStrings;
|
|
end;
|
|
|
|
function TRODLConverter.ValidateTargetEntity(const aLibrary: TRODLLibrary; const aTargetEntity: string): boolean;
|
|
begin
|
|
result := aLibrary.FindService(aTargetEntity)<>NIL;
|
|
end;
|
|
|
|
procedure TRODLConverter.Write(const someText: string; Indentation: integer = 0);
|
|
var
|
|
i: integer;
|
|
s: string;
|
|
begin
|
|
s := '';
|
|
|
|
for i := 1 to Indentation do
|
|
s := s + ' ';
|
|
s := s + someText;
|
|
|
|
fBuffer.Add(s)
|
|
end;
|
|
|
|
procedure TRODLConverter.WriteLines(const someText: string);
|
|
begin
|
|
fBuffer.Text := fBuffer.Text + someText;
|
|
end;
|
|
|
|
procedure TRODLConverter.WriteEmptyLine;
|
|
begin
|
|
fBuffer.Add('');
|
|
end;
|
|
|
|
class function TRODLConverter.GetTargetFileName(const aLibrary: TRODLLibrary;
|
|
const aTargetEntity: string): string;
|
|
begin
|
|
{$IFDEF FPC}
|
|
if (aLibrary <> nil) or (aTargetEntity <> '') then result := '' else // preventing warnings in FPC
|
|
{$ENDIF}
|
|
result := '';
|
|
end;
|
|
|
|
{ TRODLReader }
|
|
|
|
constructor TRODLReader.Create;
|
|
begin
|
|
end;
|
|
|
|
function TRODLReader.Read(aStream: TStream; const aFilename:string): TRODLLibrary;
|
|
begin
|
|
if (aStream = nil) then RaiseError(err_InvalidStream, []);
|
|
result := IntReadFromStream(aStream, aFilename)
|
|
end;
|
|
|
|
function TRODLReader.ReadFromFile(const aFileName: string): TRODLLibrary;
|
|
var
|
|
fs: TFileStream;
|
|
begin
|
|
fs := TFileStream.Create(aFileName, fmOpenRead);
|
|
try
|
|
result := Read(fs, aFilename)
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TRODLException }
|
|
|
|
procedure TRODLException.Validate(iMessages: IRoPluginMessages);
|
|
begin
|
|
inherited;
|
|
|
|
if (Ancestor <> '') and not OwnerLibrary.IsValidException(Ancestor) then
|
|
iMessages.AddMessage(rmtError,Info.Name,Format(err_RodlInvalidAncestorType,[Ancestor]),-1,self);
|
|
end;
|
|
|
|
{ TRODLUse }
|
|
|
|
procedure TRODLUse.Validate(iMessages: IRoPluginMessages);
|
|
begin
|
|
inherited;
|
|
|
|
if not (FileExists(ExpandVariables(fRodlFile)) or FileExists(fAbsoluteRodlFile)) then
|
|
iMessages.AddMessage(rmtWarning,ExtractFileName(fRodlFile),Format(err_RodlUsedFileDoesNotExist,[ExpandVariables(fRodlFile)]),-1,self);
|
|
|
|
|
|
end;
|
|
|
|
{ TXMLToRODL }
|
|
|
|
constructor TXMLToRODL.Create(iAddToExisting: TRODLLibrary; iRecreateGuids:boolean=false);
|
|
begin
|
|
Create();
|
|
fAddToExistingLibrary := iAddToExisting;
|
|
fRecreateGuids := iRecreateGuids;
|
|
end;
|
|
|
|
function TXMLToRODL.IntReadFromStream(aStream: TStream; aFilename:string): TRODLLibrary;
|
|
begin
|
|
if Assigned(fAddToExistingLibrary) then begin
|
|
result := fAddToExistingLibrary;
|
|
LoadStreamToLibrary(aStream, result, aFilename, nil, false); // Don't set RODL Attributes
|
|
end
|
|
else begin
|
|
result := TRODLLibrary.Create();
|
|
result.RodlFilename := aFilename;
|
|
LoadStreamToLibrary(aStream, result, aFilename);
|
|
end;
|
|
end;
|
|
|
|
procedure TXMLToRODL.LoadFileToLibrary(iFilename: string; iLibrary: TRODLLibrary; iRodlUse:TRODLUse=nil);
|
|
var
|
|
lStream: TStream;
|
|
begin
|
|
//ToDo: resolve relative filenames; handle http filenames, etc.
|
|
|
|
lStream := TFileStream.Create(iFilename, fmOpenRead);
|
|
try
|
|
LoadStreamToLibrary(lStream, iLibrary, iFilename, iRodlUse);
|
|
finally
|
|
lStream.Free();
|
|
end;
|
|
end;
|
|
|
|
function GetNodeAttribute(aNode: IXMLNode; const anAttributeName: string): string;
|
|
var
|
|
lAtrributeNode: IXMLNode;
|
|
begin
|
|
Result := '';
|
|
if Assigned(aNode) then begin
|
|
lAtrributeNode := aNode.GetAttributeByName(anAttributeName);
|
|
if Assigned(lAtrributeNode) then result := lAtrributeNode.Value;
|
|
end else
|
|
if CompareText(anAttributeName, 'UID') = 0 then result := GUIDToString(EmptyGUID);
|
|
end;
|
|
|
|
function ExpandFileNameByBase(const iBase, iFilename:string):string; overload;
|
|
var
|
|
lCurrentDir:string;
|
|
begin
|
|
lCurrentDir := GetCurrentDir();
|
|
SetCurrentDir(iBase);
|
|
try
|
|
result := ExpandFileName(iFilename);
|
|
finally
|
|
SetCurrentDir(lCurrentDir);
|
|
end;
|
|
end;
|
|
|
|
function FixLegacyTypes(aType: string): string;
|
|
begin
|
|
if LowerCase(aType) = 'string' then result := 'AnsiString'
|
|
else result := aType;
|
|
end;
|
|
|
|
function XMLFlagNameToFlag(const aName: string): TRODLParamFlag;
|
|
var
|
|
f: TRODLParamFlag;
|
|
begin
|
|
result := fIn;
|
|
|
|
for f := Low(TRODLParamFlag) to High(TRODLParamFlag) do
|
|
if (CompareText(XMLFlagNames[f], aName) = 0) then begin
|
|
result := f;
|
|
Exit;
|
|
end;
|
|
|
|
RaiseError(err_InvalidParamFlag, [aName]);
|
|
end;
|
|
|
|
procedure TXMLToRODL.LoadStreamToLibrary(aStream: TStream; iLibrary: TRODLLibrary; iRodlName: string = ''; iRodlUse: TRODLUse=nil; iReplaceLibraryAttributes:boolean=true);
|
|
var
|
|
fGroupGuidList: TStringList;
|
|
|
|
procedure ReadAttributes(anXMLNode: IXMLNode; aEntity: TRODLEntity);
|
|
var
|
|
lGroupID: string;
|
|
i, k: integer;
|
|
lName, lValue: string;
|
|
lNode,lChildNode:IXMLNode;
|
|
begin
|
|
if (anXMLNode = nil) then Exit;
|
|
|
|
{ read legacy v2.0 documentation attribues }
|
|
if (anXMLNode.GetAttributeByName('Documentation') <> nil) then begin
|
|
aEntity.Documentation := anXMLNode.GetAttributeByName('Documentation').Value;
|
|
end;
|
|
|
|
lValue := '';
|
|
for i := 0 to (anXMLNode.ChildrenCount-1) do begin
|
|
|
|
lNode :=anXMLNode.Children[i];
|
|
if (lNode.Name = 'CustomAttributes') then begin
|
|
|
|
for k := 0 to (lNode.ChildrenCount-1) do begin
|
|
lChildNode := lNode.Children[k];
|
|
lName := lChildNode.Name;
|
|
|
|
if (lName = '#text') then Continue;
|
|
if (lChildNode.GetAttributeByName('Value') <> nil) then begin
|
|
lValue := lChildNode.GetAttributeByName('Value').Value;
|
|
end
|
|
else begin
|
|
lValue := '';
|
|
end;
|
|
|
|
aEntity.Attributes.Values[lName] := lValue;
|
|
end;
|
|
|
|
Exit;
|
|
end
|
|
else if lNode.Name = 'Documentation' then begin
|
|
aEntity.Documentation := lNode.Value
|
|
end
|
|
else if lNode.Name = 'Group' then begin
|
|
lGroupID := lNode.GetAttributeValue('Under','');
|
|
if lGroupID <> '' then begin
|
|
aEntity.GroupUnder := iLibrary.FindGroup(StringToGUID(lGroupID));
|
|
if aEntity.GroupUnder = nil then begin
|
|
lGroupID := fGroupGuidList.Values[lGroupId];
|
|
if lGroupID <> '' then
|
|
aEntity.GroupUnder := iLibrary.FindGroup(StringToGUID(lGroupID));
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
function RODLFileIsUsed(aRODL: string): boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result:=False;
|
|
if ARodl <> '' then
|
|
if FileExists(ARodl) then
|
|
For i := 0 to iLibrary.UseCount -1 do begin
|
|
if SameText(ExpandVariables(iLibrary.Use[i].RodlFile),aRODL) or SameText(iLibrary.Use[i].AbsoluteRodlFile, aRODL) then begin
|
|
Result:=True;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
lFlag: TRODLParamFlag;
|
|
//domimpl: TDomImplementation;
|
|
//parser: TXmlToDomParser;
|
|
xmldoc: IXMLDocument;
|
|
list,
|
|
sublist,
|
|
subsublist,
|
|
lastlist: IXMLNodeList;
|
|
i, k, m, p: Integer;
|
|
|
|
lParentNode:IXMLNode;
|
|
|
|
struct: TRODLStruct;
|
|
stelem: TRODLTypedEntity;
|
|
arr: TRODLArray;
|
|
lUse: TRODLUse;
|
|
lEventSink: TRODLEventSink;
|
|
lFilename:string;
|
|
lException: TRODLException;
|
|
lGroup: TRODLGroup;
|
|
svc: TRODLService;
|
|
enum: TRODLEnum;
|
|
eval: TRODLEnumValue;
|
|
intf: TRODLServiceInterface;
|
|
op: TRODLOperation;
|
|
par: TRODLOperationParam;
|
|
|
|
begin
|
|
fGroupGuidList:= TStringList.Create;
|
|
try
|
|
xmldoc := NewROXmlDocument();
|
|
aStream.Position := 0;
|
|
xmldoc.New();
|
|
xmldoc.LoadFromStream(aStream);
|
|
|
|
if not Assigned(iRodlUse) then begin
|
|
// Library
|
|
if Assigned(xmldoc.DocumentNode) then begin
|
|
if iReplaceLibraryAttributes then begin
|
|
iLibrary.Name := GetNodeAttribute(xmldoc.DocumentNode, 'Name');
|
|
iLibrary.Namespace := GetNodeAttribute(xmldoc.DocumentNode, 'Namespace');
|
|
iLibrary.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(xmldoc.DocumentNode, 'UID')));
|
|
//iLibrary.Documentation := GetNodeAttribute(xmldoc.DocumentNode, 'Documentation');
|
|
|
|
ReadAttributes(xmldoc.DocumentNode, iLibrary);
|
|
end;
|
|
end;
|
|
end else
|
|
begin
|
|
iRodlUse.LoadedRodlLibraryName := GetNodeAttribute(xmldoc.DocumentNode, 'Name');
|
|
//
|
|
end;
|
|
|
|
// Groups
|
|
lParentNode := xmldoc.DocumentNode.GetNodeByName('Groups');
|
|
if Assigned(lParentNode) then begin
|
|
list := lParentNode.GetNodesByName('Group');
|
|
if Assigned(list) then
|
|
begin
|
|
for i := 0 to (list.Count-1) do begin
|
|
lGroup := TRODLGroup.Create;
|
|
lGroup.IsFromUsedRodl := iRodlUse <> nil;
|
|
lGroup.LocatedInRodlUse := iRodlUse;
|
|
lGroup.Name := GetNodeAttribute(list.Nodes[i], 'Name');
|
|
//lGroup.Documentation := GetNodeAttribute(list.Nodes[i], 'Documentation');
|
|
lGroup.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(list.Nodes[i], 'UID')));
|
|
fGroupGuidList.Add(GetNodeAttribute(list.Nodes[i], 'UID')+'='+GUIDToString(lGroup.Uid));
|
|
|
|
iLibrary.Add(lGroup);
|
|
end;
|
|
for i := 0 to List.count -1 do begin
|
|
lGroup := iLibrary.Groups[iLibrary.GroupCount - List.count + i];
|
|
ReadAttributes(list.Nodes[i], lGroup);
|
|
end;
|
|
end;
|
|
end; // Groups
|
|
|
|
// Uses
|
|
lParentNode := xmldoc.DocumentNode.GetNodeByName('Uses');
|
|
if Assigned(lParentNode) then begin
|
|
list := lParentNode.GetNodesByName('Use');
|
|
if Assigned(list) then begin
|
|
for i := 0 to (list.Count-1) do begin
|
|
if RODLFileIsUsed(GetNodeAttribute(list.Nodes[i], 'AbsoluteRodl')) then Continue;
|
|
if RODLFileIsUsed(ExpandVariables(GetNodeAttribute(list.Nodes[i], 'Rodl'))) then Continue;
|
|
lUse := TRODLUse.Create;
|
|
lUse.Name := GetNodeAttribute(list.Nodes[i], 'Name');
|
|
//lUse.Documentation := GetNodeAttribute(list.Nodes[i], 'Documentation');
|
|
lUse.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(list.Nodes[i], 'UID')));
|
|
lUse.RodlFile := GetNodeAttribute(list.Nodes[i], 'Rodl');
|
|
lUse.AbsoluteRodlFile := GetNodeAttribute(list.Nodes[i], 'AbsoluteRodl');
|
|
lUse.GenerateCode := GetNodeAttribute(list.Nodes[i], 'GenerateCode') = '1';
|
|
lUse.SplitMode := TRODLUseSplitMode(StrToIntDef(GetNodeAttribute(list.Nodes[i], 'SplitMode'), Integer(usmAsParent)));
|
|
|
|
ReadAttributes(list.Nodes[i], lUse);
|
|
|
|
lUse.IsFromUsedRodl := Assigned(iRodlUse);
|
|
lUse.LocatedInRodlUse := iRodlUse;
|
|
|
|
iLibrary.Add(lUse);
|
|
|
|
try
|
|
with self.ClassType.Create do try
|
|
{$IFDEF DEBUG_REMOBJECTS_RODLTOXML}
|
|
DebugServer.Write('Used RODL "%s"',[lUse.RodlFile]);
|
|
{$ENDIF}
|
|
|
|
lFilename := ExpandVariables(lUse.RodlFile);
|
|
if iRodlName <> '' then begin
|
|
if lUse.LocatedInRodlUse <> nil then
|
|
lFilename := ExpandFileNameByBase(ExtractFilePath(lUse.LocatedInRodlUse.AbsoluteRodlFile),lFilename)
|
|
else
|
|
lFilename := ExpandFileNameByBase(ExtractFilePath(iRodlName),lFilename);
|
|
if FileExists(lFilename) then
|
|
lUse.AbsoluteRodlFile := lFilename;
|
|
end;
|
|
if (not FileExists(lFilename)) and (lUse.AbsoluteRodlFile <> '') then begin
|
|
lFilename := lUse.AbsoluteRodlFile;
|
|
if FileExists(lFilename) then
|
|
lUse.RodlFile := lFilename;
|
|
end;
|
|
|
|
{$IFDEF DEBUG_REMOBJECTS_RODLTOXML}
|
|
DebugServer.Write('Loading "%s"',[lFilename]);
|
|
{$ENDIF}
|
|
|
|
LoadFileToLibrary(lFilename, iLibrary, lUse);
|
|
finally
|
|
Free();
|
|
end; { with }
|
|
except
|
|
{ ignore if an included RODL cannot be found, for most cases it wont be needed to do the CodeGen }
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
end; // Uses
|
|
|
|
// Services
|
|
lParentNode := xmldoc.DocumentNode.GetNodeByName('Services');
|
|
if Assigned(lParentNode) then begin
|
|
list := lParentNode.GetNodesByName('Service');
|
|
if Assigned(list) then begin
|
|
for i := 0 to (list.Count-1) do begin
|
|
svc := TRODLService.Create;
|
|
svc.Name := GetNodeAttribute(list.Nodes[i], 'Name');
|
|
//svc.Documentation := GetNodeAttribute(list.Nodes[i], 'Documentation');
|
|
svc.Ancestor := GetNodeAttribute(list.Nodes[i], 'Ancestor');
|
|
|
|
svc.ImplUnit := GetNodeAttribute(list.Nodes[i], 'ImplUnit');
|
|
svc.ImplClass := GetNodeAttribute(list.Nodes[i], 'ImplClass');
|
|
svc.Abstract := GetNodeAttribute(list.Nodes[i], 'Abstract') = '1';
|
|
svc.isPrivate := GetNodeAttribute(list.Nodes[i], 'Private') = '1';
|
|
svc.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(list.Nodes[i], 'UID')));
|
|
|
|
ReadAttributes(list.Nodes[i], svc);
|
|
|
|
// Default interface
|
|
// TODO: Implement multiple interfaces in the future. Not needed now
|
|
lParentNode := list.Nodes[i].GetNodeByName('Interfaces');
|
|
if Assigned(lParentNode) then begin
|
|
sublist := lParentNode.GetNodesByName('Interface');
|
|
if Assigned(sublist) and (sublist.Count > 0) then begin
|
|
//later: for k := 0 to (sublist.Length-1) do begin
|
|
k := 0;
|
|
|
|
intf := svc.Default;
|
|
intf.Name := GetNodeAttribute(sublist.Nodes[k], 'Name');
|
|
intf.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(sublist.Nodes[k], 'UID'))); // Fixed thanks to a compiler warning! Was using m as index
|
|
//intf.Documentation := GetNodeAttribute(sublist.Nodes[k], 'Documentation');
|
|
|
|
ReadAttributes(sublist.Nodes[k], intf);
|
|
|
|
// Operations
|
|
lParentNode := sublist.Nodes[k].GetNodeByName('Operations');
|
|
if Assigned(lParentNode) then begin
|
|
subsublist := lParentNode.GetNodesByName('Operation');
|
|
if Assigned(subsublist) then begin
|
|
for m := 0 to (subsublist.Count-1) do begin
|
|
op := intf.Add;
|
|
op.Name := GetNodeAttribute(subsublist.Nodes[m], 'Name');
|
|
//op.Documentation := GetNodeAttribute(subsublist.Nodes[m], 'Documentation');
|
|
op.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(subsublist.Nodes[m], 'UID')));
|
|
op.ForceAsyncResponse := GetNodeAttribute(subsublist.Nodes[m], 'ForceAsyncResponse') = '1';
|
|
|
|
ReadAttributes(subsublist.Nodes[m], op);
|
|
|
|
// Parameters
|
|
lParentNode := subsublist.Nodes[m].GetNodeByName('Parameters');
|
|
if Assigned(lParentNode) then begin
|
|
lastlist := lParentNode.GetNodesByName('Parameter');
|
|
if Assigned(lastlist) then begin
|
|
for p := 0 to (lastlist.Count-1) do begin
|
|
lFlag := XMLFlagNameToFlag(GetNodeAttribute(lastlist.Nodes[p], 'Flag'));
|
|
case lFlag of
|
|
fResult:par := op.AddResult();
|
|
else par := op.Add();
|
|
end; { case }
|
|
par.Name := GetNodeAttribute(lastlist.Nodes[p], 'Name');
|
|
//par.Documentation := GetNodeAttribute(lastlist.Nodes[p], 'Documentation');
|
|
par.Flag := lFlag;
|
|
par.DataType := FixLegacyTypes(GetNodeAttribute(lastlist.Nodes[p], 'DataType'));
|
|
ReadAttributes(lastlist.Nodes[p], par);
|
|
end;
|
|
end;
|
|
end; // Service|Interface|Operation|Parameters
|
|
|
|
// Code Bodies
|
|
lParentNode := subsublist.Nodes[m].GetNodeByName('Code');
|
|
if Assigned(lParentNode) then begin
|
|
lastlist := lParentNode.GetNodesByName('Code');
|
|
if Assigned(lastlist) then begin
|
|
for p := 0 to (lastlist.Count-1) do begin
|
|
op.SetCodeBodyAsString(GetNodeAttribute(lastlist.Nodes[p], 'Language'),lastlist.Nodes[p].Value);
|
|
end;
|
|
end;
|
|
end; // Service|Interface|Operation|Parameters
|
|
|
|
{op.MoveResult();}
|
|
end;
|
|
end;
|
|
end; // Service|Interface|Operations
|
|
end;
|
|
end; // Service|Interfaces
|
|
|
|
svc.IsFromUsedRodl := Assigned(iRodlUse);
|
|
svc.LocatedInRodlUse := iRodlUse;
|
|
|
|
iLibrary.Add(svc);
|
|
end;
|
|
end;
|
|
end; // Services
|
|
|
|
// EventSinks
|
|
lParentNode := xmldoc.DocumentNode.GetNodeByName('EventSinks');
|
|
if Assigned(lParentNode) then begin
|
|
list := lParentNode.GetNodesByName('EventSink');
|
|
if Assigned(list) then begin
|
|
for i := 0 to (list.Count-1) do begin
|
|
lEventSink := TRODLEventSink.Create;
|
|
lEventSink.Name := GetNodeAttribute(list.Nodes[i], 'Name');
|
|
//lEventSink.Documentation := GetNodeAttribute(list.Nodes[i], 'Documentation');
|
|
lEventSink.Ancestor := GetNodeAttribute(list.Nodes[i], 'Ancestor');
|
|
|
|
lEventSink.ImplUnit := GetNodeAttribute(list.Nodes[i], 'ImplUnit');
|
|
lEventSink.ImplClass := GetNodeAttribute(list.Nodes[i], 'ImplClass');
|
|
lEventSink.Abstract := GetNodeAttribute(list.Nodes[i], 'Abstract') = '1';
|
|
lEventSink.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(list.Nodes[i], 'UID')));
|
|
|
|
ReadAttributes(list.Nodes[i], lEventSink);
|
|
|
|
// Default interface
|
|
// TODO: Implement multiple interfaces in the future. Not needed now
|
|
lParentNode := list.Nodes[i].GetNodeByName('Interfaces');
|
|
if Assigned(lParentNode) then begin
|
|
sublist := lParentNode.GetNodesByName('Interface');
|
|
if Assigned(sublist) and (sublist.Count > 0) then begin
|
|
//later: for k := 0 to (sublist.Length-1) do begin
|
|
k := 0;
|
|
|
|
intf := lEventSink.Default;
|
|
intf.Name := GetNodeAttribute(sublist.Nodes[k], 'Name');
|
|
intf.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(sublist.Nodes[k], 'UID'))); // Fixed thanks to a compiler warning! Was using m as index
|
|
//intf.Documentation := GetNodeAttribute(sublist.Nodes[k], 'Documentation');
|
|
|
|
ReadAttributes(sublist.Nodes[k], intf);
|
|
|
|
// Operations
|
|
lParentNode := sublist.Nodes[k].GetNodeByName('Operations');
|
|
if Assigned(lParentNode) then begin
|
|
subsublist := lParentNode.GetNodesByName('Operation');
|
|
if Assigned(subsublist) then begin
|
|
for m := 0 to (subsublist.Count-1) do begin
|
|
op := intf.Add;
|
|
op.Name := GetNodeAttribute(subsublist.Nodes[m], 'Name');
|
|
//op.Documentation := GetNodeAttribute(subsublist.Nodes[m], 'Documentation');
|
|
op.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(subsublist.Nodes[m], 'UID')));
|
|
|
|
ReadAttributes(subsublist.Nodes[m], op);
|
|
|
|
// Parameters
|
|
lParentNode := subsublist.Nodes[m].GetNodeByName('Parameters');
|
|
if Assigned(lParentNode) then begin
|
|
lastlist := lParentNode.GetNodesByName('Parameter');
|
|
if Assigned(lastlist) then begin
|
|
for p := 0 to (lastlist.Count-1) do begin
|
|
lFlag := XMLFlagNameToFlag(GetNodeAttribute(lastlist.Nodes[p], 'Flag'));
|
|
case lFlag of
|
|
fResult:par := op.AddResult();
|
|
else par := op.Add();
|
|
end; { case }
|
|
par.Name := GetNodeAttribute(lastlist.Nodes[p], 'Name');
|
|
//par.Documentation := GetNodeAttribute(lastlist.Nodes[p], 'Documentation');
|
|
par.Flag := lFlag;
|
|
par.DataType := FixLegacyTypes(GetNodeAttribute(lastlist.Nodes[p], 'DataType'));
|
|
ReadAttributes(lastlist.Nodes[p], par);
|
|
end;
|
|
end;
|
|
end; // Service|Interface|Operation|Parameters
|
|
|
|
// Code Bodies
|
|
lParentNode := subsublist.Nodes[m].GetNodeByName('Code');
|
|
if Assigned(lParentNode) then begin
|
|
lastlist := lParentNode.GetNodesByName('Code');
|
|
if Assigned(lastlist) then begin
|
|
for p := 0 to (lastlist.Count-1) do begin
|
|
op.SetCodeBodyAsString(GetNodeAttribute(lastlist.Nodes[p], 'Language'),StringFromHexString(lastlist.Nodes[p].Value));
|
|
end;
|
|
end;
|
|
end; // Service|Interface|Operation|Parameters
|
|
|
|
{op.MoveResult();}
|
|
end;
|
|
end;
|
|
end; // Service|Interface|Operations
|
|
end;
|
|
end; // Service|Interfaces
|
|
|
|
lEventSink.IsFromUsedRodl := Assigned(iRodlUse);
|
|
lEventSink.LocatedInRodlUse := iRodlUse;
|
|
|
|
iLibrary.Add(lEventSink);
|
|
end;
|
|
end;
|
|
end; // EventSinks
|
|
|
|
//////////////////// TODO REMOVE **BELOW**
|
|
// EventSinks
|
|
lParentNode := xmldoc.DocumentNode.GetNodeByName('CallbackSinks');
|
|
if Assigned(lParentNode) then begin
|
|
list := lParentNode.GetNodesByName('CallbackSink');
|
|
if Assigned(list) then begin
|
|
for i := 0 to (list.Count-1) do begin
|
|
lEventSink := TRODLEventSink.Create;
|
|
lEventSink.Name := GetNodeAttribute(list.Nodes[i], 'Name');
|
|
//lEventSink.Documentation := GetNodeAttribute(list.Nodes[i], 'Documentation');
|
|
lEventSink.Ancestor := GetNodeAttribute(list.Nodes[i], 'Ancestor');
|
|
|
|
lEventSink.ImplUnit := GetNodeAttribute(list.Nodes[i], 'ImplUnit');
|
|
lEventSink.ImplClass := GetNodeAttribute(list.Nodes[i], 'ImplClass');
|
|
lEventSink.Abstract := GetNodeAttribute(list.Nodes[i], 'Abstract') = '1';
|
|
lEventSink.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(list.Nodes[i], 'UID')));
|
|
|
|
ReadAttributes(list.Nodes[i], lEventSink);
|
|
|
|
// Default interface
|
|
// TODO: Implement multiple interfaces in the future. Not needed now
|
|
lParentNode := list.Nodes[i].GetNodeByName('Interfaces');
|
|
if Assigned(lParentNode) then begin
|
|
sublist := lParentNode.GetNodesByName('Interface');
|
|
if Assigned(sublist) and (sublist.Count > 0) then begin
|
|
//later: for k := 0 to (sublist.Length-1) do begin
|
|
k := 0;
|
|
|
|
intf := lEventSink.Default;
|
|
intf.Name := GetNodeAttribute(sublist.Nodes[k], 'Name');
|
|
intf.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(sublist.Nodes[k], 'UID'))); // Fixed thanks to a compiler warning! Was using m as index
|
|
//intf.Documentation := GetNodeAttribute(sublist.Nodes[k], 'Documentation');
|
|
|
|
ReadAttributes(sublist.Nodes[k], intf);
|
|
|
|
// Operations
|
|
lParentNode := sublist.Nodes[k].GetNodeByName('Operations');
|
|
if Assigned(lParentNode) then begin
|
|
subsublist := lParentNode.GetNodesByName('Operation');
|
|
if Assigned(subsublist) then begin
|
|
for m := 0 to (subsublist.Count-1) do begin
|
|
op := intf.Add;
|
|
op.Name := GetNodeAttribute(subsublist.Nodes[m], 'Name');
|
|
//op.Documentation := GetNodeAttribute(subsublist.Nodes[m], 'Documentation');
|
|
op.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(subsublist.Nodes[m], 'UID')));
|
|
|
|
ReadAttributes(subsublist.Nodes[m], op);
|
|
|
|
// Parameters
|
|
lParentNode := subsublist.Nodes[m].GetNodeByName('Parameters');
|
|
if Assigned(lParentNode) then begin
|
|
lastlist := lParentNode.GetNodesByName('Parameter');
|
|
if Assigned(lastlist) then begin
|
|
for p := 0 to (lastlist.Count-1) do begin
|
|
lFlag := XMLFlagNameToFlag(GetNodeAttribute(lastlist.Nodes[p], 'Flag'));
|
|
case lFlag of
|
|
fResult:par := op.AddResult();
|
|
else par := op.Add();
|
|
end; { case }
|
|
par.Name := GetNodeAttribute(lastlist.Nodes[p], 'Name');
|
|
//par.Documentation := GetNodeAttribute(lastlist.Nodes[p], 'Documentation');
|
|
par.Flag := lFlag;
|
|
par.DataType := FixLegacyTypes(GetNodeAttribute(lastlist.Nodes[p], 'DataType'));
|
|
ReadAttributes(lastlist.Nodes[p], par);
|
|
end;
|
|
end;
|
|
end; // Service|Interface|Operation|Parameters
|
|
|
|
// Code Bodies
|
|
lParentNode := subsublist.Nodes[m].GetNodeByName('Code');
|
|
if Assigned(lParentNode) then begin
|
|
lastlist := lParentNode.GetNodesByName('Code');
|
|
if Assigned(lastlist) then begin
|
|
for p := 0 to (lastlist.Count-1) do begin
|
|
op.SetCodeBodyAsString(GetNodeAttribute(lastlist.Nodes[p], 'Language'),StringFromHexString(lastlist.Nodes[p].Value));
|
|
end;
|
|
end;
|
|
end; // Service|Interface|Operation|Parameters
|
|
|
|
{op.MoveResult();}
|
|
end;
|
|
end;
|
|
end; // Service|Interface|Operations
|
|
end;
|
|
end; // Service|Interfaces
|
|
|
|
lEventSink.IsFromUsedRodl := Assigned(iRodlUse);
|
|
lEventSink.LocatedInRodlUse := iRodlUse;
|
|
|
|
iLibrary.Add(lEventSink);
|
|
end;
|
|
end;
|
|
end; // EventSinks
|
|
//////////////////// TODO REMOVE ^^^^^^
|
|
|
|
// Structs
|
|
lParentNode := xmldoc.DocumentNode.GetNodeByName('Structs');
|
|
if Assigned(lParentNode) then begin
|
|
list := lParentNode.GetNodesByName('Struct');
|
|
if Assigned(list) then begin
|
|
for i := 0 to (list.Count-1) do begin
|
|
struct := TRODLStruct.Create;
|
|
struct.Name := GetNodeAttribute(list.Nodes[i], 'Name');
|
|
//struct.Documentation := GetNodeAttribute(list.Nodes[i], 'Documentation');
|
|
struct.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(list.Nodes[i], 'UID')));
|
|
struct.Ancestor := GetNodeAttribute(list.Nodes[i], 'Ancestor');
|
|
struct.AutoCreateParams := GetNodeAttribute(list.Nodes[i], 'AutoCreateParams') <> '0';
|
|
struct.Abstract := GetNodeAttribute(list.Nodes[i], 'Abstract') = '1';
|
|
|
|
ReadAttributes(list.Nodes[i], struct);
|
|
|
|
lParentNode := list.Nodes[i].GetNodeByName('Elements');
|
|
if Assigned(lParentNode) then begin
|
|
sublist := lParentNode.GetNodesByName('Element');
|
|
if Assigned(sublist) then begin
|
|
for p := 0 to (sublist.Count-1) do begin
|
|
stelem := struct.Add;
|
|
stelem.Name := GetNodeAttribute(sublist.Nodes[p], 'Name');
|
|
//stelem.Documentation := GetNodeAttribute(sublist.Nodes[p], 'Documentation');
|
|
stelem.DataType := FixLegacyTypes(GetNodeAttribute(sublist.Nodes[p], 'DataType'));
|
|
ReadAttributes(sublist.Nodes[p], stelem);
|
|
end;
|
|
end;
|
|
end; // Struct|Elements
|
|
|
|
struct.IsFromUsedRodl := Assigned(iRodlUse);
|
|
struct.LocatedInRodlUse := iRodlUse;
|
|
|
|
iLibrary.Add(struct);
|
|
end;
|
|
end;
|
|
end; //Structs
|
|
|
|
// Enums
|
|
lParentNode := xmldoc.DocumentNode.GetNodeByName('Enums');
|
|
if Assigned(lParentNode) then begin
|
|
list := lParentNode.GetNodesByName('Enum');
|
|
if Assigned(list) then begin
|
|
for i := 0 to (list.Count-1) do begin
|
|
enum := TRODLEnum.Create;
|
|
enum.Name := GetNodeAttribute(list.Nodes[i], 'Name');
|
|
enum.PrefixEnumValues := GetNodeAttribute(list.Nodes[i], 'Prefix') <> '0';
|
|
//enum.Documentation := GetNodeAttribute(list.Nodes[i], 'Documentation');
|
|
enum.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(list.Nodes[i], 'UID')));
|
|
|
|
ReadAttributes(list.Nodes[i], enum);
|
|
|
|
lParentNode := list.Nodes[i].GetNodeByName('EnumValues');
|
|
if Assigned(lParentNode) then begin
|
|
sublist := lParentNode.GetNodesByName('EnumValue');
|
|
if Assigned(sublist) then begin
|
|
for p := 0 to (sublist.Count-1) do begin
|
|
eval := enum.Add;
|
|
eval.Name := GetNodeAttribute(sublist.Nodes[p], 'Name');
|
|
ReadAttributes(sublist.Nodes[p], eval);
|
|
//eval.Documentation := GetNodeAttribute(sublist.Nodes[p], 'Documentation');
|
|
end;
|
|
end;
|
|
end; //Enum|EnumValues
|
|
|
|
enum.IsFromUsedRodl := Assigned(iRodlUse);
|
|
enum.LocatedInRodlUse := iRodlUse;
|
|
|
|
iLibrary.Add(enum);
|
|
end;
|
|
end;
|
|
end; // Enums
|
|
|
|
// Arrays
|
|
lParentNode := xmldoc.DocumentNode.GetNodeByName('Arrays');
|
|
if Assigned(lParentNode) then begin
|
|
list := lParentNode.GetNodesByName('Array');
|
|
if Assigned(list) then begin
|
|
for i := 0 to (list.Count-1) do begin
|
|
arr := TRODLArray.Create;
|
|
arr.Name := GetNodeAttribute(list.Nodes[i], 'Name');
|
|
//arr.Documentation := GetNodeAttribute(list.Nodes[i], 'Documentation');
|
|
arr.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(list.Nodes[i], 'UID')));
|
|
|
|
ReadAttributes(list.Nodes[i], arr);
|
|
|
|
sublist := list.Nodes[i].GetNodesByName('ElementType');
|
|
if Assigned(sublist) and (sublist.Count > 0) then
|
|
arr.ElementType := FixLegacyTypes(GetNodeAttribute(sublist.Nodes[0], 'DataType'));
|
|
|
|
arr.IsFromUsedRodl := Assigned(iRodlUse);
|
|
arr.LocatedInRodlUse := iRodlUse;
|
|
|
|
iLibrary.Add(arr)
|
|
end;
|
|
end;
|
|
end; // Arrays
|
|
|
|
// Exceptions
|
|
lParentNode := xmldoc.DocumentNode.GetNodeByName('Exceptions');
|
|
if Assigned(lParentNode) then begin
|
|
list := lParentNode.GetNodesByName('Exception');
|
|
if Assigned(list) then begin
|
|
for i := 0 to (list.Count-1) do begin
|
|
lException := TRODLException.Create;
|
|
lException.Name := GetNodeAttribute(list.Nodes[i], 'Name');
|
|
//lException.Documentation := GetNodeAttribute(list.Nodes[i], 'Documentation');
|
|
lException.UID := RecreateGuidIfNeeded(StringToGUID(GetNodeAttribute(list.Nodes[i], 'UID')));
|
|
lException.Ancestor := GetNodeAttribute(list.Nodes[i], 'Ancestor');
|
|
lException.Abstract := GetNodeAttribute(list.Nodes[i], 'Abstract') = '1';
|
|
|
|
ReadAttributes(list.Nodes[i], lException);
|
|
|
|
lParentNode := list.Nodes[i].GetNodeByName('Elements');
|
|
if Assigned(lParentNode) then begin
|
|
sublist := lParentNode.GetNodesByName('Element');
|
|
if Assigned(sublist) then begin
|
|
for p := 0 to (sublist.Count-1) do begin
|
|
stelem := lException.Add;
|
|
stelem.Name := GetNodeAttribute(sublist.Nodes[p], 'Name');
|
|
//stelem.Documentation := GetNodeAttribute(sublist.Nodes[p], 'Documentation');
|
|
stelem.DataType := FixLegacyTypes(GetNodeAttribute(sublist.Nodes[p], 'DataType'));
|
|
ReadAttributes(sublist.Nodes[p], stelem);
|
|
end;
|
|
end;
|
|
end; // Struct|Elements
|
|
|
|
lException.IsFromUsedRodl := Assigned(iRodlUse);
|
|
lException.LocatedInRodlUse := iRodlUse;
|
|
|
|
iLibrary.Add(lException)
|
|
end;
|
|
end;
|
|
end; // Exceptions
|
|
finally
|
|
fGroupGuidList.Free;
|
|
end;
|
|
end;
|
|
|
|
function TXMLToRODL.ReadFromString(const aString: string; const aFilename:string): TRODLLibrary;
|
|
var
|
|
ss: TROBinaryMemoryStream;
|
|
begin
|
|
ss := TROBinaryMemoryStream.Create;
|
|
try
|
|
ss.Write( pointer(aString)^, Length(aString)*SizeOf(Char));
|
|
result := Read(ss, aFilename);
|
|
finally
|
|
ss.Free;
|
|
end;
|
|
end;
|
|
|
|
function TXMLToRODL.RecreateGuidIfNeeded(iGuid: TGuid): TGuid;
|
|
begin
|
|
if fRecreateGuids then
|
|
result := NewGuid()
|
|
else
|
|
result := iGuid;
|
|
end;
|
|
|
|
end.
|
|
|