david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
2073 lines
57 KiB
ObjectPascal
2073 lines
57 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
|
|
{$IFDEF REMOBJECTS_TRIAL}uROTrial, {$ENDIF}
|
|
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;
|
|
|
|
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 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 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;
|
|
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 }
|
|
TRODLUse = class(TRODLEntity)
|
|
private
|
|
fRodlFile: string;
|
|
fAbsoluteRodlFile: string;
|
|
fLoadedRodlLibraryName: string;
|
|
fGenerateCode: boolean;
|
|
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;
|
|
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 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;
|
|
|
|
function ReadRODLFromFile(aReaderClass: TRODLReaderClass; const aFileName: string): TRODLLibrary;
|
|
|
|
function ExpandVariables(const aFilename:string):string;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF DEBUG_REMOBJECTS_RODL}eDebugServer, {$ENDIF}
|
|
{$IFDEF DELPHI5} ActiveX, Windows, {$ENDIF}
|
|
{$IFDEF MSWINDOWS}Registry, {$IFNDEF DELPHI5}Windows,{$ENDIF}{$ENDIF}
|
|
SysUtils, TypInfo, uRORes, uRODLToXML, uROTypes, Math;
|
|
|
|
{ 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.CalcItemsMarshalingOrder(aIncludeAncestors: boolean=true): IROStrings;
|
|
var
|
|
lAncestor: TRODLBaseStruct;
|
|
i:integer;
|
|
begin
|
|
result := NewROStrings();
|
|
result.Sorted := True;
|
|
result.Duplicates := dupIgnore;
|
|
|
|
lAncestor := self;
|
|
repeat
|
|
for i := lAncestor.Count-1 downto 0 do
|
|
result.AddObject(lAncestor.Items[i].Name, lAncestor.Items[i]);
|
|
|
|
if lAncestor.Ancestor <> '' then
|
|
lAncestor := OwnerLibrary.FindBaseStruct(lAncestor.Ancestor)
|
|
else
|
|
lAncestor := nil;
|
|
|
|
until (not Assigned(lAncestor)) or (not 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;
|
|
|
|
procedure TRODLBaseStruct.SetAncestor(const Value: string);
|
|
begin
|
|
fAncestor := Trim(Value);
|
|
end;
|
|
|
|
procedure TRODLBaseStruct.Validate(iMessages: IRoPluginMessages);
|
|
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,Info.Name,err_RodlNoStructElementsDefined,-1,self);
|
|
|
|
if (Ancestor <> '') and not OwnerLibrary.IsValidType(Ancestor) and not (self is TRODLException) then // exceptions ancestors are checked in TRODLException.Validate
|
|
iMessages.AddMessage(rmtError,Info.Name,Format(err_RodlInvalidAncestorType,[Ancestor]),-1,self);
|
|
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;
|
|
|
|
procedure TRODLBaseService.SetAncestor(const Value: string);
|
|
begin
|
|
fAncestor := Trim(Value);
|
|
end;
|
|
|
|
procedure TRODLBaseService.Validate(iMessages: IRoPluginMessages);
|
|
var
|
|
i: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,Info.Name+'.'+Items[i].Info.Name,err_RodlNoOperationsDefined,-1,self);
|
|
end;
|
|
|
|
if (Ancestor <> '') then begin
|
|
if self is TRODLEventSink then begin
|
|
if not OwnerLibrary.IsValidEventSink(Ancestor) then
|
|
iMessages.AddMessage(rmtError,Info.Name,Format(err_RodlInvalidAncestorType,[Ancestor]),-1,self);
|
|
end else begin
|
|
if not OwnerLibrary.IsValidService(Ancestor) then
|
|
iMessages.AddMessage(rmtError,Info.Name,Format(err_RodlInvalidAncestorType,[Ancestor]),-1,self);
|
|
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 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;
|
|
|
|
{ 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.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
|
|
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;
|
|
|
|
end.
|
|
|