diff --git a/Forms/MainFrm.dfm b/Forms/MainFrm.dfm
index 12b442d..35199f3 100644
--- a/Forms/MainFrm.dfm
+++ b/Forms/MainFrm.dfm
@@ -35,7 +35,7 @@ object MainForm: TMainForm
AddQuotes = False
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
- Text = 'F:\XTxXSD\Offerte.xsd'
+ Text = 'F:\XTxXSD\TelefoonGegevens.xsd'
end
object gbOutput: TGroupBox
Left = 8
diff --git a/Forms/MainFrm.pas b/Forms/MainFrm.pas
index 54f03d9..5708ae0 100644
--- a/Forms/MainFrm.pas
+++ b/Forms/MainFrm.pas
@@ -58,6 +58,8 @@ uses
procedure TMainForm.FormCreate(Sender: TObject);
begin
plOutput.ActivePageIndex := 0;
+ btnGenerate.Click;
+ ModalResult := mrCancel;
end;
diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas
index dfa055a..c4e1462 100644
--- a/Units/DelphiXMLDataBindingGenerator.pas
+++ b/Units/DelphiXMLDataBindingGenerator.pas
@@ -11,6 +11,9 @@ uses
type
TGetFileNameEvent = procedure(Sender: TObject; const SchemaName: String; var Result: String) of object;
+ TDelphiXMLSection = (dxsForward, dxsInterface, dxsClass, dxsImplementation);
+ TDelphiXMLMember = (dxmPropertyGet, dxmPropertySet, dxmPropertyDeclaration);
+
TDelphiXMLDataBindingGenerator = class(TXMLDataBindingGenerator)
private
FOnGetFileName: TGetFileNameEvent;
@@ -21,10 +24,19 @@ type
function DoGetFileName(const ASchemaName: String): String;
+ function TranslateDataType(ADataType: IXMLTypeDef): String;
+ function CreateNewGUID(): String;
+
procedure WriteUnitHeader(AStream: TStreamHelper; const AFileName: String);
- procedure WriteSchemaInterfaces(AStream: TStreamHelper; ASchemaDef: IXMLSchemaDef; AForward: Boolean);
- procedure WriteElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; AForward: Boolean);
- procedure WriteElements(AStream: TStreamHelper; AType: IXMLTypeDef);
+ procedure WriteInterface(AStream: TStreamHelper; ASchemaDef: IXMLSchemaDef; ASection: TDelphiXMLSection);
+
+ procedure WriteComplexElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; ASection: TDelphiXMLSection);
+ function WriteSimpleElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; AMember: TDelphiXMLMember): Boolean;
+ procedure WriteEnumeration(AStream: TStreamHelper; AElement: IXMLElementDef);
+
+ procedure WriteElements(AStream: TStreamHelper; AElements: IXMLElementDefs); overload;
+ procedure WriteElements(AStream: TStreamHelper; AElements: IXMLElementDefList); overload;
+
procedure WriteImplementation(AStream: TStreamHelper);
procedure WriteUnitFooter(AStream: TStreamHelper);
public
@@ -36,6 +48,46 @@ uses
SysUtils;
+const
+ SectionComments: array[TDelphiXMLSection] of String =
+ (
+ ' { Forward declarations for %s }',
+ ' { Interfaces for %s }',
+ ' { Classes for %s }',
+ '{ Implementation for %s }'
+ );
+
+ MemberPropertyGet = ' function Get%0:s: %1:s;';
+ MemberPropertySet = ' procedure Set%0:s(const Value: %1:s);';
+ MemberProperty = ' property %0:s: %1:s read Get%0:s write Set%0:s;';
+ MemberPropertyReadOnly = ' property %0:s: %1:s read Get%0:s;';
+
+
+ ReservedWords: array[0..111] of String =
+ (
+ 'absolute', 'abstract', 'and', 'array', 'as', 'asm',
+ 'assembler', 'automated', 'begin', 'case', 'cdecl', 'class',
+ 'const', 'constructor', 'contains', 'default', 'deprecated',
+ 'destructor', 'dispid', 'dispinterface', 'div', 'do',
+ 'downto', 'dynamic', 'else', 'end', 'except', 'export',
+ 'exports', 'external', 'far', 'file', 'final', 'finalization',
+ 'finally', 'for', 'forward', 'function', 'goto', 'if',
+ 'implementation', 'implements', 'in', 'index', 'inherited',
+ 'initialization', 'inline', 'interface', 'is', 'label',
+ 'library', 'local', 'message', 'mod', 'name', 'near',
+ 'nil', 'nodefault', 'not', 'object', 'of', 'or', 'out',
+ 'overload', 'override', 'package', 'packed', 'pascal',
+ 'platform', 'private', 'procedure', 'program', 'property',
+ 'protected', 'public', 'published', 'raise', 'read',
+ 'readonly', 'record', 'register', 'reintroduce', 'repeat',
+ 'requires', 'resident', 'resourcestring', 'safecall',
+ 'sealed', 'set', 'shl', 'shr', 'static', 'stdcall',
+ 'stored', 'string', 'then', 'threadvar', 'to', 'try', 'type',
+ 'unit', 'unsafe', 'until', 'uses', 'var', 'varargs',
+ 'virtual', 'while', 'with', 'write', 'writeonly', 'xor'
+ );
+
+
{ TDelphiXMLDataBindingGenerator }
procedure TDelphiXMLDataBindingGenerator.GenerateDataBinding();
begin
@@ -51,6 +103,7 @@ var
unitName: String;
unitStream: TStreamHelper;
schemaIndex: Integer;
+ section: TDelphiXMLSection;
begin
unitName := DoGetFileName(Schema[0].SchemaName);
@@ -58,20 +111,29 @@ begin
try
WriteUnitHeader(unitStream, unitName);
unitStream.WriteLn('type');
+ unitStream.WriteLn(' TXMLCollection = Variant;');
+ unitStream.WriteLn();
- for schemaIndex := 0 to Pred(SchemaCount) do
+ for section := dxsForward to dxsClass do
begin
- unitStream.WriteLn(' { Forward declarations for ' + Schema[schemaIndex].SchemaName + ' }');
- WriteSchemaInterfaces(unitStream, Schema[schemaIndex].SchemaDef, True);
- end;
-
- for schemaIndex := 0 to Pred(SchemaCount) do
- begin
- unitStream.WriteLn(' { Interfaces for ' + Schema[schemaIndex].SchemaName + ' }');
- WriteSchemaInterfaces(unitStream, Schema[schemaIndex].SchemaDef, False);
+ for schemaIndex := 0 to Pred(SchemaCount) do
+ begin
+ unitStream.WriteLn(Format(SectionComments[section], [Schema[schemaIndex].SchemaName]));
+ WriteInterface(unitStream, Schema[schemaIndex].SchemaDef, section);
+ unitStream.WriteLn();
+ end;
end;
+ unitStream.WriteLn();
WriteImplementation(unitStream);
+
+ for schemaIndex := 0 to Pred(SchemaCount) do
+ begin
+ unitStream.WriteLn(Format(SectionComments[dxsImplementation], [Schema[schemaIndex].SchemaName]));
+ WriteInterface(unitStream, Schema[schemaIndex].SchemaDef, dxsImplementation);
+ unitStream.WriteLn();
+ end;
+
WriteUnitFooter(unitStream);
finally
FreeAndNil(unitStream);
@@ -84,6 +146,34 @@ begin
end;
+function TDelphiXMLDataBindingGenerator.TranslateDataType(ADataType: IXMLTypeDef): String;
+begin
+ Result := 'Variant';
+
+ // #ToDo1 (MvR) 26-2-2008: check type mapping
+ if ADataType.IsComplex then
+ begin
+ Result := 'IXML' + ADataType.Name;
+ end else if ADataType.Enumerations.Count > 0 then
+ begin
+ Result := 'TXML' + ADataType.Name;
+ end else
+ begin
+ if ADataType.NamespaceURI = SXMLSchemaURI_2001 then
+ begin
+ if ADataType.Name = 'int' then
+ Result := 'Integer'
+ else if ADataType.Name = 'float' then
+ Result := 'Double'
+ else if ADataType.Name = 'boolean' then
+ Result := 'Boolean'
+ else if ADataType.Name = 'string' then
+ Result := 'String';
+ end;
+ end;
+end;
+
+
procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; const AFileName: String);
begin
// #ToDo1 (MvR) 14-4-2007: if outputtype = multiple, use include files
@@ -97,12 +187,13 @@ begin
AStream.WriteLn('interface');
AStream.WriteLn('uses');
AStream.WriteLn(' XMLDoc,');
- AStream.WriteLn(' XMLIntf;');
+ AStream.WriteLn(' XMLIntf,');
+ AStream.WriteLn(' Variants;');
AStream.WriteLn();
end;
-procedure TDelphiXMLDataBindingGenerator.WriteSchemaInterfaces(AStream: TStreamHelper; ASchemaDef: IXMLSchemaDef; AForward: Boolean);
+procedure TDelphiXMLDataBindingGenerator.WriteInterface(AStream: TStreamHelper; ASchemaDef: IXMLSchemaDef; ASection: TDelphiXMLSection);
procedure ProcessElementDefs(AElements: IXMLElementDefList);
var
@@ -114,10 +205,14 @@ procedure TDelphiXMLDataBindingGenerator.WriteSchemaInterfaces(AStream: TStreamH
begin
element := AElements[elementIndex];
- if element.DataType.IsComplex then
+ if not Assigned(element.Ref) then
begin
- WriteElementInterface(AStream, element, AForward);
- ProcessElementDefs(element.ChildElements);
+ if element.DataType.IsComplex and
+ element.DataType.IsAnonymous then
+ begin
+ WriteComplexElementInterface(AStream, element, ASection);
+ ProcessElementDefs(element.ChildElements);
+ end;
end;
end;
end;
@@ -133,10 +228,19 @@ begin
begin
element := ASchemaDef.ElementDefs[elementIndex];
- WriteElementInterface(AStream, element, AForward);
- if element.DataType.IsComplex then
+ if element.DataType.Enumerations.Count > 0 then
begin
- ProcessElementDefs(element.ChildElements);
+ { Enumerated type }
+ if ASection = dxsForward then
+ WriteEnumeration(AStream, element);
+ end else
+ begin
+ { Element }
+ WriteComplexElementInterface(AStream, element, ASection);
+ if element.DataType.IsComplex then
+ begin
+ ProcessElementDefs(element.ChildElements);
+ end;
end;
end;
@@ -144,18 +248,30 @@ begin
begin
complexType := ASchemaDef.ComplexTypes[complexTypeIndex];
- if AForward then
- begin
- AStream.WriteLn(' IXML' + complexType.Name + ' = interface; { ComplexType }');
- end else
- begin
- AStream.WriteLn(' IXML' + complexType.Name + ' = interface');
- AStream.WriteLn(' {TODO:GUID}');
+ case ASection of
+ dxsForward:
+ begin
+ AStream.WriteLn(' IXML' + complexType.Name + ' = interface;');
+ end;
+ dxsInterface:
+ begin
+ AStream.WriteLn(' IXML' + complexType.Name + ' = interface(IXMLNode)');
+ AStream.WriteLn(' ' + CreateNewGUID());
+ WriteElements(AStream, complexType.ElementDefs);
+ AStream.WriteLn(' end;');
+ AStream.WriteLn();
+ end;
+ dxsClass:
+ begin
+ AStream.WriteLn(Format(' TXML%0:s = class(TXMLNode, IXML%0:s)', [complexType.Name]));
+ WriteElements(AStream, complexType.ElementDefs);
+ AStream.WriteLn(' end;');
+ AStream.WriteLn();
+ end;
+ dxsImplementation:
+ begin
- WriteElements(complexType);
-
- AStream.WriteLn(' end;');
- AStream.WriteLn();
+ end;
end;
ProcessElementDefs(complexType.ElementDefList);
@@ -163,20 +279,165 @@ begin
end;
-procedure TDelphiXMLDataBindingGenerator.WriteElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; AForward: Boolean);
+procedure TDelphiXMLDataBindingGenerator.WriteComplexElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; ASection: TDelphiXMLSection);
begin
- if AForward then
+ case ASection of
+ dxsForward:
+ begin
+ AStream.WriteLn(' IXML' + AElement.Name + ' = interface;');
+ end;
+ dxsInterface:
+ begin
+ AStream.WriteLn(' IXML' + AElement.Name + ' = interface(IXMLNode)');
+ AStream.WriteLn(' ' + CreateNewGUID());
+ WriteElements(AStream, AElement.ChildElements);
+ AStream.WriteLn(' end;');
+ AStream.WriteLn();
+ end;
+ dxsClass:
+ begin
+ AStream.WriteLn(Format(' TXML%0:s = class(TXMLNode, IXML%0:s)', [AElement.Name]));
+ WriteElements(AStream, AElement.ChildElements);
+ AStream.WriteLn(' end;');
+ AStream.WriteLn();
+ end;
+ dxsImplementation:
+ begin
+ end;
+ end;
+end;
+
+
+function TDelphiXMLDataBindingGenerator.WriteSimpleElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; AMember: TDelphiXMLMember): Boolean;
+var
+ isReadOnly: Boolean;
+ memberName: String;
+ dataType: String;
+ memberFormat: String;
+
+begin
+ Result := False;
+ isReadOnly := AElement.DataType.IsComplex;
+ if isReadOnly and (AMember = dxmPropertySet) then
+ exit;
+
+ dataType := '';
+ // #ToDo1 (MvR) 22-2-2008: escape reserved words
+ memberName := AElement.Name;
+
+ if (AElement.MaxOccurs = 'unbounded') or
+ (AElement.MaxOccurs > 1) then
begin
- AStream.WriteLn(' IXML' + AElement.Name + ' = interface; { ElementDef }');
+ { Collection }
+ dataType := Format('IXML%sCollection', [AElement.Name]);
end else
begin
- // #ToDo1 (MvR) 14-4-2007: output element interface
+ dataType := TranslateDataType(AElement.DataType);
+ end;
+
+
+ case AMember of
+ dxmPropertyGet:
+ memberFormat := MemberPropertyGet;
+ dxmPropertySet:
+ memberFormat := MemberPropertySet;
+ dxmPropertyDeclaration:
+ if isReadOnly then
+ memberFormat := MemberPropertyReadOnly
+ else
+ memberFormat := MemberProperty;
+ end;
+
+ AStream.Write(Format(memberFormat, [memberName, dataType]));
+
+ if AElement.MinOccurs = 0 then
+ { Optional }
+ AStream.WriteLn(' { Optional }')
+ else
+ AStream.WriteLn();
+
+ Result := True;
+end;
+
+
+procedure TDelphiXMLDataBindingGenerator.WriteEnumeration(AStream: TStreamHelper; AElement: IXMLElementDef);
+var
+ enumerations: IXMLEnumerationCollection;
+ enumIndex: Integer;
+ enumStart: String;
+ lineIndent: String;
+
+begin
+ enumerations := AElement.DataType.Enumerations;
+ if enumerations.Count = 0 then
+ exit;
+
+ // #ToDo1 (MvR) 26-2-2008: unique prefix?
+ enumStart := Format(' TXML%s = (', [AElement.Name]);
+ AStream.Write(enumStart);
+ lineIndent := StringOfChar(' ', Length(enumStart));
+
+ for enumIndex := 0 to Pred(enumerations.Count) do
+ begin
+ if enumIndex > 0 then
+ AStream.Write(lineIndent);
+
+ AStream.Write(Format('%s_%s', [AElement.Name, enumerations[enumIndex].Value]));
+
+ if enumIndex < Pred(enumerations.Count) then
+ AStream.WriteLn(',')
+ else
+ AStream.WriteLn(');');
+ end;
+end;
+
+
+procedure TDelphiXMLDataBindingGenerator.WriteElements(AStream: TStreamHelper; AElements: IXMLElementDefList);
+var
+ elementIndex: Integer;
+ member: TDelphiXMLMember;
+ hasMembers: Boolean;
+
+begin
+ for member := Low(TDelphiXMLMember) to High(TDelphiXMLMember) do
+ begin
+ hasMembers := False;
+
+ for elementIndex := 0 to Pred(AElements.Count) do
+ if WriteSimpleElementInterface(AStream, AElements[elementIndex], member) then
+ hasMembers := True;
+
+ if hasMembers and (member < High(TDelphiXMLMember)) then
+ AStream.WriteLn();
+ end;
+end;
+
+
+procedure TDelphiXMLDataBindingGenerator.WriteElements(AStream: TStreamHelper; AElements: IXMLElementDefs);
+var
+ elementIndex: Integer;
+ member: TDelphiXMLMember;
+ hasMembers: Boolean;
+
+begin
+ for member := Low(TDelphiXMLMember) to High(TDelphiXMLMember) do
+ begin
+ hasMembers := False;
+
+ for elementIndex := 0 to Pred(AElements.Count) do
+ if WriteSimpleElementInterface(AStream, AElements[elementIndex], member) then
+ hasMembers := True;
+
+ if hasMembers and (member < High(TDelphiXMLMember)) then
+ AStream.WriteLn();
end;
end;
procedure TDelphiXMLDataBindingGenerator.WriteImplementation(AStream: TStreamHelper);
begin
+ AStream.WriteLn('implementation');
+ AStream.WriteLn();
end;
@@ -187,6 +448,17 @@ begin
end;
+function TDelphiXMLDataBindingGenerator.CreateNewGUID(): String;
+var
+ guid: TGUID;
+
+begin
+ Result := '{ GUID generation failed }';
+ if CreateGUID(guid) = S_OK then
+ Result := '[''' + GUIDToString(guid) + ''']';
+end;
+
+
function TDelphiXMLDataBindingGenerator.DoGetFileName(const ASchemaName: String): String;
begin
Result := OutputPath;
diff --git a/Units/XMLDataBindingGenerator.pas b/Units/XMLDataBindingGenerator.pas
index 388a0aa..34844ca 100644
--- a/Units/XMLDataBindingGenerator.pas
+++ b/Units/XMLDataBindingGenerator.pas
@@ -32,6 +32,7 @@ type
protected
function LoadSchema(const AStream: TStream; const ASchemaName: String): IXMLSchemaDef;
function FindSchema(const ALocation: String): TStream;
+ function SchemaLoaded(const ALocation: String): Boolean;
procedure GenerateDataBinding(); virtual; abstract;
@@ -124,11 +125,35 @@ end;
function TXMLDataBindingGenerator.LoadSchema(const AStream: TStream; const ASchemaName: String): IXMLSchemaDef;
+
+ procedure HandleDocRefs(const ADocRefs: IXMLSchemaDocRefs);
+ var
+ location: String;
+ refIndex: Integer;
+ refStream: TStream;
+
+ begin
+ for refIndex := 0 to Pred(ADocRefs.Count) do
+ begin
+ location := ADocRefs[refIndex].SchemaLocation;
+
+ if not SchemaLoaded(ChangeFileExt(location, '')) then
+ begin
+ refStream := FindSchema(location);
+
+ if Assigned(refStream) then
+ try
+ location := ChangeFileExt(ExtractFileName(location), '');
+ LoadSchema(refStream, location);
+ finally
+ FreeAndNil(refStream);
+ end;
+ end;
+ end;
+ end;
+
+
var
- includeIndex: Integer;
- includes: IXMLSchemaIncludes;
- includeStream: TStream;
- location: String;
schema: TXMLDataBindingSchema;
schemaDoc: IXMLSchemaDoc;
@@ -142,21 +167,9 @@ begin
schema.SchemaName := ASchemaName;
FSchemas.Add(schema);
- { Handle includes }
- includes := Result.SchemaIncludes;
- for includeIndex := 0 to Pred(includes.Count) do
- begin
- location := includes[includeIndex].SchemaLocation;
- includeStream := FindSchema(location);
-
- if Assigned(includeStream) then
- try
- location := ChangeFileExt(ExtractFileName(location), '');
- LoadSchema(includeStream, location);
- finally
- FreeAndNil(includeStream);
- end;
- end;
+ { Handle imports / includes }
+ HandleDocRefs(Result.SchemaImports);
+ HandleDocRefs(Result.SchemaIncludes);
end;
@@ -183,6 +196,22 @@ begin
end;
+function TXMLDataBindingGenerator.SchemaLoaded(const ALocation: String): Boolean;
+var
+ schemaIndex: Integer;
+
+begin
+ Result := False;
+
+ for schemaIndex := 0 to Pred(SchemaCount) do
+ if Schema[schemaIndex].SchemaName = ALocation then
+ begin
+ Result := True;
+ break;
+ end;
+end;
+
+
function TXMLDataBindingGenerator.GetSchemaCount(): Integer;
begin
Result := FSchemas.Count;
diff --git a/X2XMLDataBinding.bdsproj b/X2XMLDataBinding.bdsproj
index 572148e..0ec6262 100644
--- a/X2XMLDataBinding.bdsproj
+++ b/X2XMLDataBinding.bdsproj
@@ -123,7 +123,7 @@
- $(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10
+
madExcept