david
f0e35ec439
- Recompilación de RO para poner RemObjects_Core_D10 como paquete de runtime/designtime. git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@3 b6239004-a887-0f4b-9937-50029ccdca16
1215 lines
49 KiB
ObjectPascal
1215 lines
49 KiB
ObjectPascal
unit uRODLToXML;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - CodeGen }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$IFDEF LINUX}
|
|
{$I ../RemObjects.inc}
|
|
{$ELSE}
|
|
{$I ..\RemObjects.inc}
|
|
{$ENDIF LINUX}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF REMOBJECTS_TRIAL}uROTrial, {$ENDIF}
|
|
SysUtils,
|
|
Classes, uRODL;
|
|
|
|
const
|
|
XMLFlagNames: array[TRODLParamFlag] of string = (
|
|
'In', 'Out', 'InOut', 'Result');
|
|
|
|
type
|
|
{ TRODLToXML }
|
|
TRODLToXML = class(TRODLConverter)
|
|
private
|
|
fFlattenUsedRODLs:boolean;
|
|
fStyleSheet: string;
|
|
protected
|
|
procedure IntConvert(const aLibrary: TRODLLibrary; const aTargetEntity: string = ''); override;
|
|
public
|
|
constructor Create(const aLibrary: TRODLLibrary; iFlattenUsedRODLs:boolean=false); reintroduce; overload;
|
|
constructor Create(const aLibraryFile: string; iFlattenUsedRODLs:boolean=false); reintroduce; overload;
|
|
|
|
property StyleSheet: string read fStyleSheet write fStyleSheet;
|
|
end;
|
|
|
|
{ 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 XMLFlagNameToFlag(const aName: string): TRODLParamFlag;
|
|
|
|
function LoadLibraryFromXml(const aFilename: string): TRODLLibrary;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF DEBUG_REMOBJECTS_RODLTOXML}eDebugServer, {$ENDIF}
|
|
TypInfo, {$IFDEF DELPHI5}ComObj,{$ENDIF}
|
|
uROClasses, uRORes, uROXMLIntf;
|
|
|
|
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;
|
|
|
|
function LoadLibraryFromXml(const aFilename: string): TRODLLibrary;
|
|
begin
|
|
with TXMLToRODL.Create do try
|
|
result := ReadFromFile(aFilename);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
constructor TRODLToXML.Create(const aLibrary: TRODLLibrary; iFlattenUsedRODLs: boolean);
|
|
begin
|
|
fFlattenUsedRODLs := iFlattenUsedRODLs;
|
|
inherited Create(aLibrary);
|
|
end;
|
|
|
|
constructor TRODLToXML.Create(const aLibraryFile: string; iFlattenUsedRODLs: boolean);
|
|
begin
|
|
fFlattenUsedRODLs := iFlattenUsedRODLs;
|
|
inherited Create(aLibraryFIle);
|
|
end;
|
|
|
|
procedure TRODLToXML.IntConvert(const aLibrary: TRODLLibrary; const aTargetEntity: string = '');
|
|
const
|
|
CRLF = #13#10;
|
|
|
|
function Indent(SpaceCount: byte): string;
|
|
{var
|
|
i: integer;}
|
|
begin
|
|
result := '';
|
|
{for i := 1 to SpaceCount do
|
|
result := result + ' ';}
|
|
end;
|
|
|
|
function CleanCDATA(const aString:string):string;
|
|
var
|
|
lLength:integer;
|
|
begin
|
|
result := aString;
|
|
lLength := length(aString);
|
|
while (lLength > 0) and (result[lLength] in [#09,#10,#13,#32]) do dec(lLength);
|
|
SetLength(result,lLength);
|
|
for lLength := Length(Result) downto 1 do
|
|
if Result[lLength] in [#0..#8,#11,#12,#14..#31] then result[lLength] := #32;
|
|
result := StringReplace(result, ']]>', ']]>', [rfReplaceAll]);
|
|
end;
|
|
|
|
procedure WriteAsCData(var XML: string; aData: string);
|
|
begin
|
|
xml := xml + '<![CDATA['+UTF8Encode(CleanCDATA(aData))+']]>';
|
|
end;
|
|
|
|
procedure WriteAttributes(var XML: string; aEntity: TRODLEntity);
|
|
var
|
|
attr: integer;
|
|
begin
|
|
if aEntity.Documentation <> '' then begin
|
|
xml := xml + Indent(6) + '<Documentation>' ;
|
|
WriteAsCData(xml,aEntity.Documentation);
|
|
xml := xml + '</Documentation>';
|
|
end;
|
|
if (aEntity.Attributes.Count > 0) then begin
|
|
with aEntity.Attributes do begin
|
|
xml := xml + Indent(6) + '<CustomAttributes>' + CRLF;
|
|
|
|
for attr := 0 to (aEntity.Attributes.Count - 1) do
|
|
xml := xml + Indent(9) + Format('<%s Value="%s" />',
|
|
[Names[attr], Values[Names[attr]]]) + CRLF;
|
|
|
|
xml := xml + Indent(6) + '</CustomAttributes>' + CRLF;
|
|
end;
|
|
end;
|
|
if Assigned(aEntity.GroupUnder) then begin
|
|
xml := xml + Indent(6) + Format('<Group Under="%s" />',[GUIDToString(aEntity.GroupUnder.UID)]) + CRLF;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
lAdd: string;
|
|
i, k, m, p: integer;
|
|
s, xml: string;
|
|
lAdditional: string;
|
|
lUsedRodlFilename,lUsedRodlFilename_absolute:string;
|
|
begin
|
|
with aLibrary do try
|
|
lAdditional := '';
|
|
if Namespace <> '' then lAdditional := 'Namespace="'+Namespace+'" ';
|
|
|
|
xml := '<?xml version="1.0" encoding="utf-8"?>' + CRLF;
|
|
if fStyleSheet <> '' then
|
|
xml := xml + '<?xml-stylesheet type="text/xsl" href="' + fStyleSheet + '"?>' + CRLF;
|
|
|
|
xml := xml + Format('<Library Name="%s" '+lAdditional+'UID="%s" Version="3.0">', [Name, GUIDToString(UID)]) + CRLF;
|
|
WriteAttributes(xml, aLibrary);
|
|
// Services
|
|
|
|
if GroupCount > 0 then begin
|
|
xml := xml + Indent(3) + '<Groups>' + CRLF;
|
|
for i := 0 to (GroupCount - 1) do begin
|
|
if fFlattenUsedRODLs or not Groups[i].IsFromUsedRodl then begin
|
|
with Groups[i] do begin
|
|
xml := xml + Indent(6) + Format('<Group Name="%s" UID="%s">', [Name, GUIDToString(UID)]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + Indent(6) + '</Group>' + CRLF;
|
|
end;
|
|
end;
|
|
end;
|
|
xml := xml + Indent(3) + '</Groups>' + CRLF;
|
|
end;
|
|
|
|
xml := xml + Indent(3) + '<Services>' + CRLF;
|
|
for i := 0 to (ServiceCount - 1) do begin
|
|
if fFlattenUsedRODLs or not Services[i].IsFromUsedRodl then
|
|
with Services[i] do begin
|
|
|
|
lAdditional := '';
|
|
if ImplUnit <> '' then lAdditional := ' ImplUnit="' + ImplUnit + '"';
|
|
if ImplClass <> '' then lAdditional := lAdditional + ' ImplClass="' + ImplClass + '"';
|
|
if Ancestor <> '' then lAdditional := lAdditional + ' Ancestor="' + Ancestor + '"';
|
|
if Abstract then lAdditional := lAdditional + ' Abstract="1"';
|
|
if isPrivate then lAdditional := lAdditional + ' Private="1"';
|
|
|
|
xml := xml + Indent(6) + Format('<Service Name="%s" UID="%s"' + lAdditional + '>', [Name, GUIDToString(UID)]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
|
|
xml := xml + Indent(6) + '<Interfaces>' + CRLF;
|
|
|
|
for k := 0 to (Count - 1) do begin
|
|
with Items[k] do begin
|
|
xml := xml + Indent(9) + Format('<Interface Name="%s" UID="%s">', [Name, GUIDToString(UID)]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
|
|
xml := xml + Indent(6) + '<Operations>' + CRLF;
|
|
for m := 0 to (Count - 1) do begin
|
|
with Items[m] do begin
|
|
if ForceAsyncResponse then
|
|
xml := xml + Indent(9) + Format('<Operation Name="%s" UID="%s" ForceAsyncResponse="1">', [Name, GUIDToString(UID)]) + CRLF
|
|
else
|
|
xml := xml + Indent(9) + Format('<Operation Name="%s" UID="%s">', [Name, GUIDToString(UID)]) + CRLF;
|
|
|
|
WriteAttributes(xml, Info);
|
|
|
|
xml := xml + Indent(6) + '<Parameters>' + CRLF;
|
|
|
|
if Assigned(Result) then with Result do begin
|
|
with Result do begin
|
|
xml := xml+ Format('<Parameter Name="%s" DataType="%s" Flag="%s">', [Name, DataType, XMLFlagNames[Flag]]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + '</Parameter>' + CRLF;
|
|
end;
|
|
end;
|
|
|
|
for p := 0 to (Count - 1) do begin
|
|
with Items[p] do begin
|
|
xml := xml + Format('<Parameter Name="%s" DataType="%s" Flag="%s" >', [Name, DataType, XMLFlagNames[Flag]]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + '</Parameter>' + CRLF;
|
|
end;
|
|
end;
|
|
xml := xml + Indent(6) + '</Parameters>' + CRLF;
|
|
|
|
if CodeBodyCount > 0 then begin
|
|
xml := xml + Indent(6) + '<Code>' + CRLF;
|
|
for p := 0 to CodeBodyCount-1 do begin
|
|
xml := xml + Indent(6) + '<Code Language="'+CodeBodyLanguages[p]+'" >';
|
|
WriteAsCData(xml, CodeBodies[CodeBodyLanguages[p]].Text);
|
|
xml := xml + '</Code>' + CRLF;
|
|
end;
|
|
xml := xml + Indent(6) + '</Code>' + CRLF;
|
|
end;
|
|
|
|
xml := xml + Indent(9) + '</Operation>' + CRLF;
|
|
end;
|
|
end;
|
|
xml := xml + Indent(6) + '</Operations>' + CRLF;
|
|
|
|
xml := xml + Indent(9) + '</Interface>' + CRLF;
|
|
end;
|
|
end;
|
|
|
|
xml := xml + Indent(6) + '</Interfaces>' + CRLF;
|
|
xml := xml + Indent(6) + '</Service>' + CRLF;
|
|
end;
|
|
end;
|
|
xml := xml + Indent(3) + '</Services>' + CRLF;
|
|
|
|
// EventSinks
|
|
if EventSinkCount > 0 then begin
|
|
xml := xml + Indent(3) + '<EventSinks>' + CRLF;
|
|
for i := 0 to (EventSinkCount - 1) do begin
|
|
if fFlattenUsedRODLs or not EventSinks[i].IsFromUsedRodl then
|
|
with EventSinks[i] do begin
|
|
|
|
lAdditional := '';
|
|
if ImplUnit <> '' then lAdditional := ' ImplUnit="' + ImplUnit + '"';
|
|
if ImplClass <> '' then lAdditional := lAdditional + ' ImplClass="' + ImplClass + '"';
|
|
if Ancestor <> '' then lAdditional := lAdditional + ' Ancestor="' + Ancestor + '"';
|
|
if Abstract then lAdditional := lAdditional + ' Abstract="1"';
|
|
xml := xml + Indent(6) + Format('<EventSink Name="%s" UID="%s"' + lAdditional + '>', [Name, GUIDToString(UID)]) + CRLF;
|
|
|
|
WriteAttributes(xml, Info);
|
|
|
|
xml := xml + Indent(6) + '<Interfaces>' + CRLF;
|
|
|
|
for k := 0 to (Count - 1) do begin
|
|
with Items[k] do begin
|
|
xml := xml + Indent(9) +
|
|
Format('<Interface Name="%s" UID="%s">', [Name, GUIDToString(UID)]) + CRLF;
|
|
|
|
WriteAttributes(xml, Info);
|
|
|
|
xml := xml + Indent(6) + '<Operations>' + CRLF;
|
|
for m := 0 to (Count - 1) do begin
|
|
with Items[m] do begin
|
|
xml := xml + Indent(9) +
|
|
Format('<Operation Name="%s" UID="%s">', [Name, GUIDToString(UID)]) + CRLF;
|
|
|
|
WriteAttributes(xml, Info);
|
|
|
|
xml := xml + Indent(6) + '<Parameters>' + CRLF;
|
|
|
|
{ ToDo: cloned from above for now; implement "proper" RODL->XML for 3.0 }
|
|
if Assigned(Result) then with Result do begin
|
|
with Result do begin
|
|
xml := xml + Format('<Parameter Name="%s" DataType="%s" Flag="%s">', [Name, DataType, XMLFlagNames[Flag]]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + '</Parameter>' + CRLF;
|
|
end;
|
|
end;
|
|
|
|
for p := 0 to (Count - 1) do begin
|
|
with Items[p] do begin
|
|
xml := xml + Format('<Parameter Name="%s" DataType="%s" Flag="%s">', [Name, DataType, XMLFlagNames[Flag]]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + '</Parameter>' + CRLF;
|
|
end;
|
|
end;
|
|
xml := xml + Indent(6) + '</Parameters>' + CRLF;
|
|
xml := xml + Indent(9) + '</Operation>' + CRLF;
|
|
end;
|
|
end;
|
|
xml := xml + Indent(6) + '</Operations>' + CRLF;
|
|
|
|
xml := xml + Indent(9) + '</Interface>' + CRLF;
|
|
end;
|
|
end;
|
|
|
|
xml := xml + Indent(6) + '</Interfaces>' + CRLF;
|
|
xml := xml + Indent(6) + '</EventSink>' + CRLF;
|
|
end;
|
|
end;
|
|
xml := xml + Indent(3) + '</EventSinks>' + CRLF;
|
|
end;
|
|
|
|
// Structs
|
|
xml := xml + Indent(3) + '<Structs>' + CRLF;
|
|
for i := 0 to (StructCount - 1) do begin
|
|
|
|
if fFlattenUsedRODLs or not Structs[i].IsFromUsedRodl then
|
|
with Structs[i] do begin
|
|
|
|
lAdd := '';
|
|
if AutoCreateParams then
|
|
lAdd := ' AutoCreateParams="1"'
|
|
else
|
|
lAdd := ' AutoCreateParams="0"';
|
|
|
|
if Ancestor <> '' then lAdd := lAdd+Format(' Ancestor="%s"',[Ancestor]);
|
|
if Abstract then lAdd := lAdd + ' Abstract="1"';
|
|
|
|
xml := xml + Indent(6) + Format('<Struct Name="%s" UID="%s"'+lAdd+'>',
|
|
[Name, GUIDToString(UID)]) + CRLF;
|
|
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + Indent(3) + '<Elements>' + CRLF;
|
|
for k := 0 to (Count - 1) do begin
|
|
with Items[k] do begin
|
|
xml := xml + Indent(9) + Format('<Element Name="%s" DataType="%s">', [Name, DataType]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + Indent(9) + Format('</Element>', [Name, DataType]) + CRLF;
|
|
end;
|
|
end;
|
|
xml := xml + Indent(3) + '</Elements>' + CRLF;
|
|
xml := xml + Indent(6) + '</Struct>' + CRLF;
|
|
end;
|
|
|
|
end;
|
|
xml := xml + Indent(3) + '</Structs>' + CRLF;
|
|
|
|
// Enums
|
|
xml := xml + Indent(3) + '<Enums>' + CRLF;
|
|
for i := 0 to (EnumCount - 1) do begin
|
|
|
|
if fFlattenUsedRODLs or not Enums[i].IsFromUsedRodl then
|
|
with Enums[i] do begin
|
|
if not PrefixEnumValues then
|
|
xml := xml + Indent(6) + Format('<Enum Name="%s" UID="%s" Prefix="0">', [Name, GUIDToString(UID)]) + CRLF
|
|
else
|
|
xml := xml + Indent(6) + Format('<Enum Name="%s" UID="%s">', [Name, GUIDToString(UID)]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + Indent(3) + '<EnumValues>' + CRLF;
|
|
for k := 0 to (Count - 1) do begin
|
|
with Items[k] do begin
|
|
xml := xml + Indent(9) + Format('<EnumValue Name="%s">', [Name]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + Indent(9) + '</EnumValue>' + CRLF;
|
|
end;
|
|
end;
|
|
xml := xml + Indent(3) + '</EnumValues>' + CRLF;
|
|
xml := xml + Indent(6) + '</Enum>' + CRLF;
|
|
end;
|
|
end;
|
|
xml := xml + Indent(3) + '</Enums>' + CRLF;
|
|
|
|
// Arrays
|
|
xml := xml + Indent(3) + '<Arrays>' + CRLF;
|
|
for i := 0 to (ArrayCount - 1) do begin
|
|
if fFlattenUsedRODLs or not Arrays[i].IsFromUsedRodl then
|
|
with Arrays[i] do begin
|
|
xml := xml + Indent(6) + Format('<Array Name="%s" UID="%s">', [Name, GUIDToString(UID)]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + Indent(3) + Format('<ElementType DataType="%s" />', [ElementType]) + CRLF;
|
|
xml := xml + Indent(6) + '</Array>' + CRLF;
|
|
end;
|
|
|
|
end;
|
|
xml := xml + Indent(3) + '</Arrays>' + CRLF;
|
|
|
|
// Use
|
|
if UseCount > 0 then begin
|
|
xml := xml + Indent(3) + '<Uses>' + CRLF;
|
|
for i := 0 to (UseCount - 1) do begin
|
|
if (not fFlattenUsedRODLs) and (not Use[i].IsFromUsedRodl) then
|
|
with Use[i] do begin
|
|
lUsedRodlFilename := RodlFile;
|
|
lUsedRodlFilename_absolute := AbsoluteRodlFile;
|
|
if lUsedRodlFilename_absolute = '' then
|
|
lUsedRodlFilename_absolute := ExpandFileName(ExpandVariables(lUsedRodlFilename));
|
|
{if aLibrary.RodlFilename <> '' then
|
|
lUsedRodlFilename := ExtractRelativePath(ExtractFilePath(aLibrary.RodlFilename),lUsedRodlFilename);}
|
|
|
|
if GenerateCode then
|
|
xml := xml + Indent(6) + Format('<Use Name="%s" UID="%s" Rodl="%s" GenerateCode="1" AbsoluteRodl="%s">',
|
|
[Name, GUIDToString(UID), lUsedRodlFilename, lUsedRodlFilename_absolute]) + CRLF
|
|
else
|
|
xml := xml + Indent(6) + Format('<Use Name="%s" UID="%s" Rodl="%s" AbsoluteRodl="%s">',
|
|
[Name, GUIDToString(UID), lUsedRodlFilename, lUsedRodlFilename_absolute]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + Indent(6) + '</Use>'
|
|
end;
|
|
|
|
end;
|
|
xml := xml + Indent(3) + '</Uses>' + CRLF;
|
|
end;
|
|
|
|
// Exceptions
|
|
if ExceptionCount > 0 then begin
|
|
xml := xml + Indent(3) + '<Exceptions>' + CRLF;
|
|
for i := 0 to (ExceptionCount - 1) do begin
|
|
if fFlattenUsedRODLs or not Exceptions[i].IsFromUsedRodl then
|
|
with Exceptions[i] do begin
|
|
|
|
lAdd := '';
|
|
if AutoCreateParams then
|
|
lAdd := ' AutoCreateParams="1"'
|
|
else
|
|
lAdd := ' AutoCreateParams="0"';
|
|
|
|
if Ancestor <> '' then lAdd := lAdd+Format(' Ancestor="%s"',[Ancestor]);
|
|
if Abstract then lAdd := lAdd + ' Abstract="1"';
|
|
|
|
xml := xml + Indent(6) + Format('<Exception Name="%s" UID="%s"'+lAdd+'>',[Name, GUIDToString(UID)]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + Indent(3) + '<Elements>' + CRLF;
|
|
for k := 0 to (Count - 1) do begin
|
|
with Items[k] do begin
|
|
xml := xml + Indent(9) + Format('<Element Name="%s" DataType="%s">', [Name, DataType]) + CRLF;
|
|
WriteAttributes(xml, Info);
|
|
xml := xml + Indent(9) + Format('</Element>', [Name, DataType]) + CRLF;
|
|
end;
|
|
end;
|
|
xml := xml + Indent(3) + '</Elements>' + CRLF;
|
|
xml := xml + Indent(6) + '</Exception>' + CRLF
|
|
end;
|
|
|
|
end;
|
|
xml := xml + Indent(3) + '</Exceptions>' + CRLF;
|
|
end;
|
|
|
|
xml := xml + '</Library>' + CRLF;
|
|
finally
|
|
Buffer.Text := xml;
|
|
end;
|
|
end;
|
|
|
|
{ TXMLToRODL }
|
|
|
|
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;
|
|
|
|
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 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 StringToGUID(const s: string): TGUID;
|
|
begin
|
|
if s = '' then Result := NewGuid else begin
|
|
try
|
|
Result := Sysutils.StringToGUID(s);
|
|
except
|
|
on e: EConvertError do
|
|
Result := NewGuid;
|
|
end;
|
|
end;
|
|
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';
|
|
|
|
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(iRodlName),lUse.LocatedInRodlUse.AbsoluteRodlFile)
|
|
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 := 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 := 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 := 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 := 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 := 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 := 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: TStringStream;
|
|
begin
|
|
ss := TStringStream.Create(aString);
|
|
try
|
|
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.
|
|
|