Implemented simple interfaces

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

Forms/MainFrm.pas

@@ -58,6 +58,8 @@ uses
 procedure TMainForm.FormCreate(Sender: TObject);
 begin
   plOutput.ActivePageIndex := 0;
+  btnGenerate.Click;
+  ModalResult := mrCancel;
 end;
 
 

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 WriteInterface(AStream: TStreamHelper; ASchemaDef: IXMLSchemaDef; ASection: TDelphiXMLSection);
-    procedure WriteElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; AForward: Boolean);
+
-    procedure WriteElements(AStream: TStreamHelper; AType: IXMLTypeDef);
+    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 section := dxsForward to dxsClass do
+    begin
       for schemaIndex := 0 to Pred(SchemaCount) do
       begin
-      unitStream.WriteLn('  { Forward declarations for ' + Schema[schemaIndex].SchemaName + ' }');
+        unitStream.WriteLn(Format(SectionComments[section], [Schema[schemaIndex].SchemaName]));
-      WriteSchemaInterfaces(unitStream, Schema[schemaIndex].SchemaDef, True);
+        WriteInterface(unitStream, Schema[schemaIndex].SchemaDef, section);
-    end;
+        unitStream.WriteLn();
-
+      end;
-    for schemaIndex := 0 to Pred(SchemaCount) do
-    begin
-      unitStream.WriteLn('  { Interfaces for ' + Schema[schemaIndex].SchemaName + ' }');
-      WriteSchemaInterfaces(unitStream, Schema[schemaIndex].SchemaDef, False);
     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,13 +205,17 @@ 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);
+        if element.DataType.IsComplex and
+           element.DataType.IsAnonymous then
+        begin
+          WriteComplexElementInterface(AStream, element, ASection);
           ProcessElementDefs(element.ChildElements);
         end;
       end;
     end;
+  end;
 
 var
   elementIndex:         Integer;
@@ -133,50 +228,216 @@ begin
   begin
     element := ASchemaDef.ElementDefs[elementIndex];
 
-    WriteElementInterface(AStream, element, AForward);
+    if element.DataType.Enumerations.Count > 0 then
+    begin
+      { 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;
 
   for complexTypeIndex := 0 to Pred(ASchemaDef.ComplexTypes.Count) do
   begin
     complexType := ASchemaDef.ComplexTypes[complexTypeIndex];
 
-    if AForward then
+    case ASection of
+      dxsForward:
         begin
-      AStream.WriteLn('  IXML' + complexType.Name + ' = interface; { ComplexType }');
+          AStream.WriteLn('  IXML' + complexType.Name + ' = interface;');
-    end else
+        end;
+      dxsInterface:
         begin
-      AStream.WriteLn('  IXML' + complexType.Name + ' = interface');
+          AStream.WriteLn('  IXML' + complexType.Name + ' = interface(IXMLNode)');
-      AStream.WriteLn('    {TODO:GUID}');
+          AStream.WriteLn('    ' + CreateNewGUID());
-
+          WriteElements(AStream, complexType.ElementDefs);
-      WriteElements(complexType);
-
           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
+
+        end;
+    end;
 
     ProcessElementDefs(complexType.ElementDefList);
   end;
 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; { ElementDef }');
+        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
+    { 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;

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
-  includeIndex:   Integer;
-  includes:       IXMLSchemaIncludes;
-  includeStream:  TStream;
     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
   schema:         TXMLDataBindingSchema;
   schemaDoc:      IXMLSchemaDoc;
 
@@ -142,21 +167,9 @@ begin
   schema.SchemaName := ASchemaName;
   FSchemas.Add(schema);
 
-  { Handle includes }
+  { Handle imports / includes }
-  includes  := Result.SchemaIncludes;
+  HandleDocRefs(Result.SchemaImports);
-  for includeIndex := 0 to Pred(includes.Count) do
+  HandleDocRefs(Result.SchemaIncludes);
-  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;
 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;

X2XMLDataBinding.bdsproj

@@ -123,7 +123,7 @@
 			<Directories Name="UnitOutputDir"></Directories>
 			<Directories Name="PackageDLLOutputDir"></Directories>
 			<Directories Name="PackageDCPOutputDir"></Directories>
-			<Directories Name="SearchPath">$(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10</Directories>
+			<Directories Name="SearchPath"></Directories>
 			<Directories Name="Packages"></Directories>
 			<Directories Name="Conditionals">madExcept</Directories>
 			<Directories Name="DebugSourceDirs"></Directories>