From 6b4e61e3f795c03e5c75dc7719d03afbb2985270 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Sun, 9 Mar 2008 20:36:27 +0000 Subject: [PATCH] Merged "mapping" branch into trunk --- Forms/MainFrm.dfm | 2 +- Units/DelphiXMLDataBindingGenerator.pas | 1168 +++++++++++++++++------ Units/XMLDataBindingGenerator.pas | 1129 +++++++++++++++++++++- Units/XMLDataBindingHelpers.pas | 17 + X2XMLDataBinding.cfg | 40 + X2XMLDataBindingCmdLine.bdsproj | 170 ++++ X2XMLDataBindingCmdLine.cfg | 40 + X2XMLDataBindingCmdLine.dof | 145 +++ X2XMLDataBindingCmdLine.dpr | 24 + 9 files changed, 2400 insertions(+), 335 deletions(-) create mode 100644 X2XMLDataBinding.cfg create mode 100644 X2XMLDataBindingCmdLine.bdsproj create mode 100644 X2XMLDataBindingCmdLine.cfg create mode 100644 X2XMLDataBindingCmdLine.dof create mode 100644 X2XMLDataBindingCmdLine.dpr diff --git a/Forms/MainFrm.dfm b/Forms/MainFrm.dfm index 35199f3..a00b3b5 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\TelefoonGegevens.xsd' + Text = 'F:\XTxXSD\Dealer.xsd' end object gbOutput: TGroupBox Left = 8 diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas index c4e1462..dd4f233 100644 --- a/Units/DelphiXMLDataBindingGenerator.pas +++ b/Units/DelphiXMLDataBindingGenerator.pas @@ -5,6 +5,8 @@ uses Classes, XMLSchema, + X2UtHashes, + XMLDataBindingGenerator, XMLDataBindingHelpers; @@ -17,28 +19,39 @@ type TDelphiXMLDataBindingGenerator = class(TXMLDataBindingGenerator) private FOnGetFileName: TGetFileNameEvent; + FProcessedItems: TX2OIHash; protected procedure GenerateDataBinding(); override; procedure GenerateSingleDataBinding(); procedure GenerateMultipleDataBinding(); + function DelphiSafeName(const AName: String): String; + function TranslateItemName(AItem: TXMLDataBindingItem): String; override; + function DoGetFileName(const ASchemaName: String): String; + function TranslateDataType(ADataType: IXMLTypeDef): String; function CreateNewGUID(): String; procedure WriteUnitHeader(AStream: TStreamHelper; const AFileName: String); - 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 WriteInterface(AStream: TStreamHelper); procedure WriteImplementation(AStream: TStreamHelper); procedure WriteUnitFooter(AStream: TStreamHelper); + procedure WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection); + procedure WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection); + procedure WriteEnumerationConstants(AStream: TStreamHelper); + procedure WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem); + + procedure WriteSchemaItem(AStream: TStreamHelper; AItem: TXMLDataBindingItem; ASection: TDelphiXMLSection); + procedure WriteSchemaInterface(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection); + procedure WriteSchemaInterfaceProperties(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection); + procedure WriteSchemaCollection(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection); + procedure WriteSchemaCollectionProperties(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection); + procedure WriteSchemaEnumeration(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration; ASection: TDelphiXMLSection); + procedure WriteSchemaEnumerationArray(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration); + + property ProcessedItems: TX2OIHash read FProcessedItems; public property OnGetFileName: TGetFileNameEvent read FOnGetFileName write FOnGetFileName; end; @@ -57,12 +70,33 @@ const '{ Implementation for %s }' ); + + PrefixInterface = 'IXML'; + PrefixClass = 'TXML'; + PrefixOptional = 'Has'; + PostfixText = 'Text'; + + + InterfaceItemForward = ' ' + PrefixInterface + '%0:s = interface;'; + InterfaceItemInterface = ' ' + PrefixInterface + '%0:s = interface(%1:s)'; + InterfaceItemClass = ' ' + PrefixClass + '%0:s = class(%1:s, ' + PrefixInterface + '%0:s)'; + + + CollectionInterface = 'IXMLNodeCollection'; + CollectionClass = 'TXMLNodeCollection'; + + ItemInterface = 'IXMLNode'; + ItemClass = 'TXMLNode'; + + 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;'; + // #ToDo1 (MvR) 9-3-2008: document / node / etc + // #ToDo1 (MvR) 9-3-2008: WideString etc ? ReservedWords: array[0..111] of String = ( 'absolute', 'abstract', 'and', 'array', 'as', 'asm', @@ -88,6 +122,15 @@ const ); + SimpleTypeMapping: array[0..3, 0..1] of String = + ( + ('int', 'Integer'), + ('float', 'Double'), + ('boolean', 'Boolean'), + ('string', 'WideString') + ); + + { TDelphiXMLDataBindingGenerator } procedure TDelphiXMLDataBindingGenerator.GenerateDataBinding(); begin @@ -102,37 +145,33 @@ procedure TDelphiXMLDataBindingGenerator.GenerateSingleDataBinding(); var unitName: String; unitStream: TStreamHelper; - schemaIndex: Integer; - section: TDelphiXMLSection; begin - unitName := DoGetFileName(Schema[0].SchemaName); + unitName := DoGetFileName(Schemas[0].SchemaName); unitStream := TStreamHelper.Create(TFileStream.Create(unitName, fmCreate), soOwned); try WriteUnitHeader(unitStream, unitName); - unitStream.WriteLn('type'); - unitStream.WriteLn(' TXMLCollection = Variant;'); - unitStream.WriteLn(); + + WriteInterface(unitStream); + WriteSection(unitStream, dxsForward); - for section := dxsForward to dxsClass do - begin - 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; + FProcessedItems := TX2OIHash.Create(); + try + FProcessedItems.Clear(); + WriteSection(unitStream, dxsInterface); + + FProcessedItems.Clear(); + WriteSection(unitStream, dxsClass); + finally + FreeAndNil(FProcessedItems); end; - unitStream.WriteLn(); + WriteDocumentFunctions(unitStream, dxsInterface); + WriteEnumerationConstants(unitStream); + 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; + WriteDocumentFunctions(unitStream, dxsImplementation); + WriteSection(unitStream, dxsImplementation); WriteUnitFooter(unitStream); finally @@ -147,36 +186,66 @@ end; function TDelphiXMLDataBindingGenerator.TranslateDataType(ADataType: IXMLTypeDef): String; +var + mappingIndex: Integer; + dataTypeName: string; + begin + Assert(not ADataType.IsComplex, 'Complex DataTypes not supported'); + Assert(ADataType.Enumerations.Count = 0, 'Enumerations not supported'); Result := 'Variant'; - // #ToDo1 (MvR) 26-2-2008: check type mapping - if ADataType.IsComplex then + if (ADataType.NamespaceURI = SXMLSchemaURI_1999) or + (ADataType.NamespaceURI = SXMLSchemaURI_2000_10) or + (ADataType.NamespaceURI = SXMLSchemaURI_2001) then begin - Result := 'IXML' + ADataType.Name; - end else if ADataType.Enumerations.Count > 0 then + dataTypeName := ADataType.Name; + + for mappingIndex := Low(SimpleTypeMapping) to High(SimpleTypeMapping) do + if SimpleTypeMapping[mappingIndex][0] = dataTypeName then + begin + Result := SimpleTypeMapping[mappingIndex][1]; + Break; + end; + end; +end; + + +function TDelphiXMLDataBindingGenerator.DelphiSafeName(const AName: String): String; +var + wordIndex: Integer; + +begin + Result := AName; + + for wordIndex := Low(ReservedWords) to High(ReservedWords) do begin - Result := 'TXML' + ADataType.Name; - end else - begin - if ADataType.NamespaceURI = SXMLSchemaURI_2001 then + if Result = ReservedWords[wordIndex] 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'; + Result := '_' + Result; + Break; end; end; end; +function TDelphiXMLDataBindingGenerator.TranslateItemName(AItem: TXMLDataBindingItem): String; +begin + Result := DelphiSafeName(inherited TranslateItemName(AItem)); + + case AItem.ItemType of + itCollection: + Result := Result + 'List'; + + itEnumerationMember: + Result := TXMLDataBindingEnumerationMember(AItem).Enumeration.TranslatedName + '_' + Result; + end; +end; + + procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; const AFileName: String); begin - // #ToDo1 (MvR) 14-4-2007: if outputtype = multiple, use include files + // #ToDo3 (MvR) 14-4-2007: if outputtype = multiple, use include files AStream.WriteLn('{'); AStream.WriteLn(' X2Software XML Data Binding Wizard'); @@ -184,253 +253,18 @@ begin AStream.WriteLn('}'); AStream.WriteLn('unit ' + ChangeFileExt(ExtractFileName(AFileName), '') + ';'); AStream.WriteLn(); +end; + + +procedure TDelphiXMLDataBindingGenerator.WriteInterface(AStream: TStreamHelper); +begin AStream.WriteLn('interface'); AStream.WriteLn('uses'); + AStream.WriteLn(' Classes,'); AStream.WriteLn(' XMLDoc,'); - AStream.WriteLn(' XMLIntf,'); - AStream.WriteLn(' Variants;'); + AStream.WriteLn(' XMLIntf;'); AStream.WriteLn(); -end; - - -procedure TDelphiXMLDataBindingGenerator.WriteInterface(AStream: TStreamHelper; ASchemaDef: IXMLSchemaDef; ASection: TDelphiXMLSection); - - procedure ProcessElementDefs(AElements: IXMLElementDefList); - var - elementIndex: Integer; - element: IXMLElementDef; - - begin - for elementIndex := 0 to Pred(AElements.Count) do - begin - element := AElements[elementIndex]; - - if not Assigned(element.Ref) then - begin - if element.DataType.IsComplex and - element.DataType.IsAnonymous then - begin - WriteComplexElementInterface(AStream, element, ASection); - ProcessElementDefs(element.ChildElements); - end; - end; - end; - end; - -var - elementIndex: Integer; - element: IXMLElementDef; - complexTypeIndex: Integer; - complexType: IXMLComplexTypeDef; - -begin - for elementIndex := 0 to Pred(ASchemaDef.ElementDefs.Count) do - begin - element := ASchemaDef.ElementDefs[elementIndex]; - - 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]; - - 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 - - end; - end; - - ProcessElementDefs(complexType.ElementDefList); - end; -end; - - -procedure TDelphiXMLDataBindingGenerator.WriteComplexElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; ASection: TDelphiXMLSection); -begin - 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 - { Collection } - dataType := Format('IXML%sCollection', [AElement.Name]); - end else - begin - 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; + AStream.WriteLn('type'); end; @@ -448,6 +282,757 @@ begin end; +procedure TDelphiXMLDataBindingGenerator.WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection); +var + schemaIndex: Integer; + schema: TXMLDataBindingSchema; + itemIndex: Integer; + +begin + for schemaIndex := 0 to Pred(SchemaCount) do + begin + schema := Schemas[schemaIndex]; + AStream.WriteLnFmt(SectionComments[ASection], [schema.SchemaName]); + + for itemIndex := 0 to Pred(schema.ItemCount) do + WriteSchemaItem(AStream, schema.Items[itemIndex], ASection); + + AStream.WriteLn; + end; +end; + + +procedure TDelphiXMLDataBindingGenerator.WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection); + + procedure WriteFunction(const AItemName, AFunction, AImplementation: String; const AVariables: String = ''); + begin + if ASection = dxsInterface then + AStream.Write(' '); + + AStream.WriteLnFmt('function ' + AFunction + ': %1:s%0:s;', + [AItemName, PrefixInterface]); + + if ASection = dxsImplementation then + begin + if Length(AVariables) > 0 then + begin + AStream.WriteLn('var'); + AStream.WriteLn(AVariables); + AStream.WriteLn(); + end; + + AStream.WriteLn('begin'); + AStream.WriteLn(AImplementation); + AStream.WriteLn('end;'); + AStream.WriteLn(); + end; + end; + + +var + schemaIndex: Integer; + schema: TXMLDataBindingSchema; + itemIndex: Integer; + item: TXMLDataBindingItem; + interfaceItem: TXMLDataBindingInterface; + hasItem: Boolean; + docBinding: String; + +begin + hasItem := False; + + for schemaIndex := 0 to Pred(SchemaCount) do + begin + schema := Schemas[schemaIndex]; + + for itemIndex := 0 to Pred(schema.ItemCount) do + begin + item := schema.Items[itemIndex]; + + if item.ItemType = itInterface then + begin + interfaceItem := TXMLDataBindingInterface(item); + + if item.DocumentElement then + begin + if not hasItem then + begin + if ASection = dxsInterface then + AStream.Write(' '); + + AStream.WriteLn('{ Document functions }'); + hasItem := True; + end; + + docBinding := Format('GetDocBinding(''%0:s'', %1:s%0:s, TargetNamespace) as %2:s%0:s', + [interfaceItem.TranslatedName, + PrefixClass, + PrefixInterface]); + + WriteFunction(interfaceItem.TranslatedName, + 'Get%0:s(ADocument: IXMLDocument)', + ' Result := ADocument.' + docBinding); + + WriteFunction(interfaceItem.TranslatedName, + 'Load%0:s(const AFileName: String)', + ' Result := LoadXMLDocument(AFileName).' + docBinding); + + WriteFunction(interfaceItem.TranslatedName, + 'Load%0:sFromStream(AStream: TStream)', + ' doc := NewXMLDocument;'#13#10 + + ' doc.LoadFromStream(AStream);'#13#10 + + ' Result := GetOfferte(doc);', + ' doc: IXMLDocument'); + + WriteFunction(interfaceItem.TranslatedName, + 'New%0:s', + ' Result := NewXMLDocument.' + docBinding); + + AStream.WriteLn(); + end; + end; + end; + end; + + if hasItem and (ASection = dxsInterface) then + begin + // #ToDo3 (MvR) 9-3-2008: namespace support? + AStream.WriteLn('const'); + AStream.WriteLn(' TargetNamespace = '''';'); + AStream.WriteLn(); + end; +end; + + +procedure TDelphiXMLDataBindingGenerator.WriteEnumerationConstants(AStream: TStreamHelper); +var + item: TXMLDataBindingItem; + itemIndex: Integer; + schema: TXMLDataBindingSchema; + schemaIndex: Integer; + hasItem: Boolean; + +begin + { Write array constants for enumerations } + hasItem := False; + + for schemaIndex := 0 to Pred(SchemaCount) do + begin + schema := Schemas[schemaIndex]; + + for itemIndex := 0 to Pred(schema.ItemCount) do + begin + item := schema.Items[itemIndex]; + + if item.ItemType = itEnumeration then + begin + if not hasItem then + AStream.WriteLn('const'); + + WriteSchemaEnumerationArray(AStream, TXMLDataBindingEnumeration(item)); + hasItem := True; + end; + end; + end; +end; + + +procedure TDelphiXMLDataBindingGenerator.WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem); +var + lines: TStringList; + lineIndex: Integer; + +begin + // #ToDo2 (MvR) 9-3-2008: check for Delphi comment-ending sequences + if not AItem.HasDocumentation then + exit; + + lines := TStringList.Create(); + try + lines.Text := WrapText(AItem.Documentation, 76); + + AStream.WriteLn(' {'); + for lineIndex := 0 to Pred(lines.Count) do + AStream.WriteLn(' ' + lines[lineIndex]); + + AStream.WriteLn(' }'); + finally + FreeAndNil(lines); + end; +end; + + +procedure TDelphiXMLDataBindingGenerator.WriteSchemaItem(AStream: TStreamHelper; AItem: TXMLDataBindingItem; ASection: TDelphiXMLSection); +begin + case AItem.ItemType of + itInterface: WriteSchemaInterface(AStream, TXMLDataBindingInterface(AItem), ASection); + itCollection: WriteSchemaCollection(AStream, TXMLDataBindingCollection(AItem), ASection); + itEnumeration: WriteSchemaEnumeration(AStream, TXMLDataBindingEnumeration(AItem), ASection); + end; +end; + + +procedure TDelphiXMLDataBindingGenerator.WriteSchemaInterface(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection); +var + parent: String; + +begin + if ASection in [dxsInterface, dxsClass] then + begin + { Ensure the base item is completely defined first, Delphi doesn't allow + inheritance with just a forward declaration. } + if ProcessedItems.Exists(AItem) then + exit; + + if Assigned(AItem.BaseItem) then + WriteSchemaInterface(AStream, AItem.BaseItem, ASection); + + ProcessedItems[AItem] := 1; + end; + + + case ASection of + dxsForward: + AStream.WriteLnFmt(InterfaceItemForward, [AItem.TranslatedName]); + dxsInterface: + begin + if Assigned(AItem.BaseItem) then + parent := PrefixInterface + AItem.BaseItem.TranslatedName + else + parent := ItemInterface; + + WriteDocumentation(AStream, AItem); + AStream.WriteLnFmt(InterfaceItemInterface, [AItem.TranslatedName, + parent]); + AStream.WriteLnFmt(' %s', [CreateNewGUID()]); + + WriteSchemaInterfaceProperties(AStream, AItem, ASection); + + AStream.WriteLn(' end;'); + AStream.WriteLn(); + end; + dxsClass: + begin + if Assigned(AItem.BaseItem) then + parent := PrefixClass + AItem.BaseItem.TranslatedName + else + parent := ItemClass; + + AStream.WriteLnFmt(InterfaceItemClass, [AItem.TranslatedName, + parent]); + + WriteSchemaInterfaceProperties(AStream, AItem, ASection); + + AStream.WriteLn(' end;'); + AStream.WriteLn(); + end; + dxsImplementation: + begin + WriteSchemaInterfaceProperties(AStream, AItem, ASection); + end; + end; +end; + + +procedure TDelphiXMLDataBindingGenerator.WriteSchemaInterfaceProperties(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection); + + procedure WriteAfterConstruction; + var + propertyIndex: Integer; + propertyItem: TXMLDataBindingProperty; + itemProperty: TXMLDataBindingItemProperty; + hasInterface: Boolean; + + begin + hasInterface := False; + + for propertyIndex := 0 to Pred(AItem.PropertyCount) do + begin + propertyItem := AItem.Properties[propertyIndex]; + + if propertyItem.PropertyType = ptItem then + begin + itemProperty := TXMLDataBindingItemProperty(propertyItem); + + if Assigned(itemProperty.Item) and + (itemProperty.Item.ItemType <> itEnumeration) then + begin + case ASection of + dxsClass: + begin + AStream.WriteLn(' public'); + AStream.WriteLn(' procedure AfterConstruction; override;'); + break; + end; + dxsImplementation: + begin + if not hasInterface then + begin + AStream.WriteLnFmt('procedure %1:s%0:s.AfterConstruction;', + [AItem.TranslatedName, + PrefixClass]); + AStream.WriteLn('begin'); + hasInterface := True; + end; + + AStream.WriteLnFmt(' RegisterChildNode(''%0:s'', %2:s%1:s);', + [itemProperty.Item.Name, + itemProperty.Item.TranslatedName, + PrefixClass]); + end; + end; + end; + end; + end; + + if (ASection = dxsImplementation) and hasInterface then + begin + AStream.WriteLn('end;'); + AStream.WriteLn(); + end; + end; + + +var + propertyIndex: Integer; + itemProperty: TXMLDataBindingProperty; + propertyItem: TXMLDataBindingItem; + dataTypeName: String; + propertyFormat: String; + optionalFormat: String; + writeOptional: Boolean; + writeTextProp: Boolean; + hasMembers: Boolean; + localHasMembers: Boolean; + member: TDelphiXMLMember; + value: String; + +begin + // #ToDo1 (MvR) 9-3-2008: refactor WriteSchemaInterfaceProperties + if ASection = dxsForward then + Exit; + + if ASection = dxsImplementation then + WriteAfterConstruction(); + + hasMembers := False; + + for member := Low(TDelphiXMLMember) to High(TDelphiXMLMember) do + begin + localHasMembers := False; + + for propertyIndex := 0 to Pred(AItem.PropertyCount) do + begin + itemProperty := AItem.Properties[propertyIndex]; + dataTypeName := ''; + writeTextProp := False; + + { Get data type } + case itemProperty.PropertyType of + ptSimple: + dataTypeName := TranslateDataType(TXMLDataBindingSimpleProperty(itemProperty).DataType); + ptItem: + begin + propertyItem := TXMLDataBindingItemProperty(itemProperty).Item; + if Assigned(propertyItem) then + begin + if propertyItem.ItemType = itEnumeration then + begin + dataTypeName := PrefixClass; + writeTextProp := True; + end else + dataTypeName := PrefixInterface; + + dataTypeName := dataTypeName + propertyItem.TranslatedName; + end; + end; + end; + + + if Length(dataTypeName) > 0 then + begin + writeOptional := itemProperty.IsOptional and + (member in [dxmPropertyGet, dxmPropertyDeclaration]); + + case ASection of + dxsInterface, + dxsClass: + begin + { Interface declaration } + propertyFormat := ''; + optionalFormat := ''; + + case member of + dxmPropertyGet: + begin + propertyFormat := MemberPropertyGet; + optionalFormat := propertyFormat; + end; + + dxmPropertySet: + if not itemProperty.IsReadOnly then + begin + propertyFormat := MemberPropertySet; + optionalFormat := ''; + end; + + dxmPropertyDeclaration: + begin + if itemProperty.IsReadOnly then + propertyFormat := MemberPropertyReadOnly + else + propertyFormat := MemberProperty; + + optionalFormat := MemberPropertyReadOnly; + end; + end; + + + if Length(propertyFormat) > 0 then + begin + if not hasMembers then + begin + if ASection = dxsClass then + AStream.WriteLn(' protected'); + end else if not localHasMembers then + AStream.WriteLn(); + + if writeOptional then + AStream.WriteLnFmt(optionalFormat, [PrefixOptional + itemProperty.TranslatedName, + 'Boolean']); + + if writeTextProp then + AStream.WriteLnFmt(propertyFormat, [itemProperty.TranslatedName + PostfixText, + 'WideString']); + + AStream.WriteLnFmt(propertyFormat, [itemProperty.TranslatedName, + dataTypeName]); + hasMembers := True; + localHasMembers := True; + end; + end; + dxsImplementation: + begin + { Implementation } + case member of + dxmPropertyGet: + begin + // #ToDo3 (MvR) 7-3-2008: extract strings + if writeOptional then + begin + AStream.WriteLnFmt('function %0:s%1s.Get%2:s%3:s: Boolean;', + [PrefixClass, + AItem.TranslatedName, + PrefixOptional, + itemProperty.TranslatedName]); + AStream.WriteLn('begin'); + AStream.WriteLnFmt(' Result := Assigned(ChildNodes.FindNode(''%0:s''));', [itemProperty.Name]); + AStream.WriteLn('end;'); + AStream.WriteLn(); + end; + + + if writeTextProp then + begin + AStream.WriteLnFmt('function %0:s%1s.Get%3:s%2:s: WideString;', + [PrefixClass, + AItem.TranslatedName, + PostfixText, + itemProperty.TranslatedName]); + AStream.WriteLn('begin'); + AStream.WriteLnFmt(' Result := ChildNodes[''%0:s''].NodeValue;', [itemProperty.Name]); + AStream.WriteLn('end;'); + AStream.WriteLn(); + end; + + + AStream.WriteLnFmt('function %0:s%1:s.Get%2:s: %3:s;', + [PrefixClass, + AItem.TranslatedName, + itemProperty.TranslatedName, + dataTypeName]); + + case itemProperty.PropertyType of + ptSimple: + begin + AStream.WriteLn('begin'); + AStream.WriteLnFmt(' Result := ChildNodes[''%0:s''].NodeValue;', + [itemProperty.Name]); + end; + + ptItem: + begin + propertyItem := TXMLDataBindingItemProperty(itemProperty).Item; + + case propertyItem.ItemType of + itInterface, + itCollection: + begin + AStream.WriteLn('begin'); + AStream.WriteLnFmt(' Result := (ChildNodes[''%0:s''] as %1:s%2:s);', + [itemProperty.Name, + PrefixInterface, + propertyItem.TranslatedName]); + end; + + itEnumeration: + begin + AStream.WriteLn( 'var'); + AStream.WriteLn( ' nodeValue: WideString;'); + AStream.WriteLnFmt(' enumValue: %0:s;', [dataTypeName]); + AStream.WriteLn(); + AStream.WriteLn( 'begin'); + AStream.WriteLnFmt(' Result := %0:s(-1);', [dataTypeName]); + AStream.WriteLnFmt(' nodeValue := Get%0:sText;', [itemProperty.TranslatedName]); + AStream.WriteLnFmt(' for enumValue := Low(%0:s) to High(%0:s) do', [dataTypeName]); + AStream.WriteLnFmt(' if %0:sValues[enumValue] = nodeValue then', [propertyItem.TranslatedName]); + AStream.WriteLn( ' begin'); + AStream.WriteLn( ' Result := enumValue;'); + AStream.WriteLn( ' break;'); + AStream.WriteLn( ' end;'); + end; + end; + end; + end; + + AStream.WriteLn('end;'); + AStream.WriteLn(); + end; + dxmPropertySet: + if not itemProperty.IsReadOnly then + begin + if writeTextProp then + begin + AStream.WriteLnFmt('procedure %0:s%1:s.Set%2:s%3:s(const Value: WideString);', + [PrefixClass, + AItem.TranslatedName, + itemProperty.TranslatedName, + PostfixText]); + AStream.WriteLn('begin'); + AStream.WriteLnFmt(' ChildNodes[''%s''].NodeValue := Value;', [itemProperty.Name]); + AStream.WriteLn('end;'); + AStream.WriteLn(); + end; + + if (itemProperty.PropertyType = ptItem) and + (TXMLDataBindingItemProperty(itemProperty).Item.ItemType = itEnumeration) then + value := Format('%0:sValues[Value]', + [TXMLDataBindingItemProperty(itemProperty).Item.TranslatedName]) + else + value := 'Value'; + + AStream.WriteLnFmt('procedure %0:s%1:s.Set%2:s(const Value: %3:s);', + [PrefixClass, + AItem.TranslatedName, + itemProperty.TranslatedName, + dataTypeName]); + AStream.WriteLn('begin'); + AStream.WriteLnFmt(' ChildNodes[''%0s''].NodeValue := %1:s;', [itemProperty.Name, value]); + AStream.WriteLn('end;'); + AStream.WriteLn(); + end; + end; + end; + end; + end; + end; + end; + + if ASection = dxsClass then + WriteAfterConstruction(); +end; + + +procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollection(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection); +begin + case ASection of + dxsForward: + AStream.WriteLnFmt(InterfaceItemForward, [AItem.TranslatedName]); + dxsInterface: + begin + AStream.WriteLnFmt(InterfaceItemInterface, [AItem.TranslatedName, + CollectionInterface]); + AStream.WriteLnFmt(' %s', [CreateNewGUID()]); + + WriteSchemaCollectionProperties(AStream, AItem, ASection); + + AStream.WriteLn(' end;'); + AStream.WriteLn(); + end; + dxsClass: + begin + AStream.WriteLnFmt(InterfaceItemClass, [AItem.TranslatedName, + CollectionClass]); + + WriteSchemaCollectionProperties(AStream, AItem, ASection); + + AStream.WriteLn(' end;'); + AStream.WriteLn(); + end; + dxsImplementation: + begin + WriteSchemaCollectionProperties(AStream, AItem, ASection); + end; + end; +end; + + +procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollectionProperties(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection); + + procedure WriteMethodInterface(const AFunction: String); + begin + AStream.WriteLnFmt(' function ' + AFunction + ': %1:s%0:s;', + [AItem.CollectionItem.TranslatedName, + PrefixInterface]); + end; + + + procedure WriteMethodImplementation(const AFunction, AImplementation: String); + begin + AStream.WriteLnFmt('function %3:s%0:s.' + AFunction + ': %2:s%1:s;', + [AItem.TranslatedName, + AItem.CollectionItem.TranslatedName, + PrefixInterface, + PrefixClass]); + AStream.WriteLn('begin'); + + AStream.WriteLnFmt(AImplementation, + [AItem.CollectionItem.TranslatedName, + PrefixInterface]); + + AStream.WriteLn('end;'); + AStream.WriteLn(); + end; + + +begin + if ASection = dxsClass then + AStream.WriteLn(' protected'); + + + case ASection of + dxsInterface, + dxsClass: + begin + WriteMethodInterface('Get_%0:s(Index: Integer)'); + WriteMethodInterface('Add'); + WriteMethodInterface('Insert(Index: Integer)'); + end; + dxsImplementation: + begin + AStream.WriteLnFmt('procedure %1:s%0:s.AfterConstruction;', + [AItem.TranslatedName, + PrefixClass]); + AStream.WriteLn('begin'); + + AStream.WriteLnFmt(' RegisterChildNode(''%0:s'', %2:s%1:s);', + [AItem.CollectionItem.Name, + AItem.CollectionItem.TranslatedName, + PrefixClass]); + + AStream.WriteLn(); + AStream.WriteLnFmt(' ItemTag := ''%0:s'';', + [AItem.CollectionItem.Name]); + + AStream.WriteLnFmt(' ItemInterface := %1:s%0:s;', + [AItem.CollectionItem.TranslatedName, + PrefixInterface]); + + AStream.WriteLn(); + AStream.WriteLn(' inherited;'); + AStream.WriteLn('end;'); + AStream.WriteLn(); + + WriteMethodImplementation('Get_%1:s(Index: Integer)', + ' Result := (List[Index] as %1:s%0:s);'); + + WriteMethodImplementation('Add', + ' Result := (AddItem(-1) as %1:s%0:s);'); + + WriteMethodImplementation('Insert(Index: Integer)', + ' Result := (AddItem(Index) as %1:s%0:s);'); + end; + end; + + case ASection of + dxsInterface: + begin + AStream.WriteLn; + AStream.WriteLnFmt(' property %0:s[Index: Integer]: %1:s%0:s read Get_%0:s; default;', + [AItem.CollectionItem.TranslatedName, + PrefixInterface]); + end; + + dxsClass: + begin + AStream.WriteLn(' public'); + AStream.WriteLn(' procedure AfterConstruction; override;'); + end; + end; +end; + + +procedure TDelphiXMLDataBindingGenerator.WriteSchemaEnumeration(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration; ASection: TDelphiXMLSection); +var + memberIndex: Integer; + enumStart: String; + lineIndent: String; + +begin + if (ASection <> dxsForward) or (AItem.MemberCount = 0) then + exit; + + enumStart := Format(' %0:s%1:s = (', [PrefixClass, AItem.TranslatedName]); + AStream.Write(enumStart); + lineIndent := StringOfChar(' ', Length(enumStart)); + + for memberIndex := 0 to Pred(AItem.MemberCount) do + begin + if memberIndex > 0 then + AStream.Write(lineIndent); + + AStream.Write(AItem.Members[memberIndex].TranslatedName); + + if memberIndex < Pred(AItem.MemberCount) then + AStream.WriteLn(',') + else + AStream.WriteLn(');'); + end; +end; + + +procedure TDelphiXMLDataBindingGenerator.WriteSchemaEnumerationArray(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration); +var + memberIndex: Integer; + enumStart: String; + lineIndent: String; + +begin + if (AItem.MemberCount = 0) then + exit; + + enumStart := Format(' %0:sValues: ', [AItem.TranslatedName]); + AStream.WriteLn(enumStart + Format('array[%0:s%1:s] of WideString =', + [PrefixClass, AItem.TranslatedName])); + lineIndent := StringOfChar(' ', Length(enumStart)); + + AStream.WriteLn(lineIndent + '('); + + for memberIndex := 0 to Pred(AItem.MemberCount) do + begin + AStream.Write(Format('%s ''%s''', [lineIndent, AItem.Members[memberIndex].Name])); + + if memberIndex < Pred(AItem.MemberCount) then + AStream.WriteLn(',') + else + AStream.WriteLn(); + end; + + AStream.WriteLn(lineIndent + ');'); + AStream.WriteLn(); +end; + + function TDelphiXMLDataBindingGenerator.CreateNewGUID(): String; var guid: TGUID; @@ -472,3 +1057,4 @@ begin end; end. + diff --git a/Units/XMLDataBindingGenerator.pas b/Units/XMLDataBindingGenerator.pas index 34844ca..84c3bc2 100644 --- a/Units/XMLDataBindingGenerator.pas +++ b/Units/XMLDataBindingGenerator.pas @@ -1,5 +1,8 @@ unit XMLDataBindingGenerator; +// #ToDo1 (MvR) 7-3-2008: check if List items can be collapsed if an item is +// already a list parent +// #ToDo3 (MvR) 7-3-2008: enum collections? interface uses Classes, @@ -7,38 +10,71 @@ uses XMLSchema; type - TXMLDataBindingSchema = class(TObject) - private - FSchemaDef: IXMLSchemaDef; - FSchemaName: String; - public - property SchemaDef: IXMLSchemaDef read FSchemaDef write FSchemaDef; - property SchemaName: String read FSchemaName write FSchemaName; - end; + TXMLDataBindingSchema = class; + TXMLDataBindingItem = class; + TXMLDataBindingInterface = class; + TXMLDataBindingCollection = class; + TXMLDataBindingEnumerationMember = class; + TXMLDataBindingEnumeration = class; + TXMLDataBindingProperty = class; + TXMLDataBindingOutputType = (otSingle, otMultiple); + TXMLDataBindingItemType = (itInterface, itCollection, itEnumeration, + itEnumerationMember, itProperty, itForward); + TXMLDataBindingInterfaceType = (ifElement, ifComplexType); + TXMLDataBindingPropertyType = (ptSimple, ptItem); + + + TXMLDataBindingIterateItemsProc = procedure(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean) of object; + TXMLDataBindingGenerator = class(TObject) private FIncludePaths: TStrings; - FOutputPath: string; + FOutputPath: String; FOutputType: TXMLDataBindingOutputType; FSourceFileName: String; FSchemas: TObjectList; function GetSchemaCount(): Integer; - function GetSchema(Index: Integer): TXMLDataBindingSchema; + function GetSchemas(Index: Integer): TXMLDataBindingSchema; protected - function LoadSchema(const AStream: TStream; const ASchemaName: String): IXMLSchemaDef; - function FindSchema(const ALocation: String): TStream; - function SchemaLoaded(const ALocation: String): Boolean; + function LoadSchema(const AStream: TStream; const ASchemaName: String): TXMLDataBindingSchema; + function GetSchemaData(const ALocation: String): TStream; + function FindSchema(const ALocation: String): TXMLDataBindingSchema; + + procedure GenerateSchemaObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean); + procedure GenerateElementObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean); + procedure GenerateComplexTypeObjects(ASchema: TXMLDataBindingSchema); + + function ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem; + procedure ProcessChildElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef; AInterface: TXMLDataBindingInterface); + + function IterateSchemaItems(ASchema: TXMLDataBindingSchema; AIterateProc: TXMLDataBindingIterateItemsProc; AData: Pointer): TXMLDataBindingItem; + + procedure FindInterfaceProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean); + function FindInterface(ASchema: TXMLDataBindingSchema; const AName: String; AType: TXMLDataBindingInterfaceType): TXMLDataBindingInterface; + + procedure FindCollectionProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean); + function FindCollection(ASchema: TXMLDataBindingSchema; const AName: String): TXMLDataBindingCollection; + + procedure FindEnumerationProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean); + function FindEnumeration(ASchema: TXMLDataBindingSchema; const AName: String): TXMLDataBindingEnumeration; + + procedure ResolveSchema(ASchema: TXMLDataBindingSchema); + procedure ResolveNameConflicts(); + + procedure TranslateSchema(ASchema: TXMLDataBindingSchema); + procedure TranslateItem(AItem: TXMLDataBindingItem); + function TranslateItemName(AItem: TXMLDataBindingItem): String; virtual; procedure GenerateDataBinding(); virtual; abstract; - property SourceFileName: String read FSourceFileName write FSourceFileName; - property SchemaCount: Integer read GetSchemaCount; - property Schema[Index: Integer]: TXMLDataBindingSchema read GetSchema; + property SourceFileName: String read FSourceFileName write FSourceFileName; + property SchemaCount: Integer read GetSchemaCount; + property Schemas[Index: Integer]: TXMLDataBindingSchema read GetSchemas; public constructor Create(); destructor Destroy(); override; @@ -48,16 +84,218 @@ type property IncludePaths: TStrings read FIncludePaths; property OutputType: TXMLDataBindingOutputType read FOutputType write FOutputType; - property OutputPath: string read FOutputPath write FOutputPath; + property OutputPath: String read FOutputPath write FOutputPath; + end; + + + TXMLDataBindingSchema = class(TObject) + private + FIncludes: TObjectList; + FItems: TObjectList; + FItemsGenerated: Boolean; + FSchemaDef: IXMLSchemaDef; + FSchemaName: String; + + function GetItemCount(): Integer; + function GetItems(Index: Integer): TXMLDataBindingItem; + function GetIncludeCount(): Integer; + function GetIncludes(Index: Integer): TXMLDataBindingSchema; + protected + procedure AddInclude(ASchema: TXMLDataBindingSchema); + procedure AddItem(AItem: TXMLDataBindingItem); + + property ItemsGenerated: Boolean read FItemsGenerated write FItemsGenerated; + public + constructor Create(); + destructor Destroy(); override; + + property IncludeCount: Integer read GetIncludeCount; + property Includes[Index: Integer]: TXMLDataBindingSchema read GetIncludes; + + property SchemaDef: IXMLSchemaDef read FSchemaDef write FSchemaDef; + property SchemaName: String read FSchemaName write FSchemaName; + + property ItemCount: Integer read GetItemCount; + property Items[Index: Integer]: TXMLDataBindingItem read GetItems; + end; + + + TXMLDataBindingItem = class(TObject) + private + FDocumentElement: Boolean; + FName: String; + FSchemaItem: IXMLSchemaItem; + FTranslatedName: String; + + function GetDocumentation(): String; + function GetHasDocumentation(): Boolean; + protected + function GetItemType(): TXMLDataBindingItemType; virtual; abstract; + procedure SetName(const Value: String); + procedure SetTranslatedName(const Value: string); + + property SchemaItem: IXMLSchemaItem read FSchemaItem; + public + constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String); + + property DocumentElement: Boolean read FDocumentElement write FDocumentElement; + property Documentation: String read GetDocumentation; + property HasDocumentation: Boolean read GetHasDocumentation; + property ItemType: TXMLDataBindingItemType read GetItemType; + property Name: String read FName; + property TranslatedName: String read FTranslatedName; + end; + + + TXMLDataBindingInterface = class(TXMLDataBindingItem) + private + FInterfaceType: TXMLDataBindingInterfaceType; + FProperties: TObjectList; + FBaseName: String; + FBaseItem: TXMLDataBindingInterface; + + function GetProperties(Index: Integer): TXMLDataBindingProperty; + function GetPropertyCount: Integer; + protected + function GetItemType(): TXMLDataBindingItemType; override; + + procedure AddProperty(AProperty: TXMLDataBindingProperty); + public + constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String); + destructor Destroy; override; + + property BaseName: String read FBaseName write FBaseName; + property BaseItem: TXMLDataBindingInterface read FBaseItem write FBaseItem; + + property InterfaceType: TXMLDataBindingInterfaceType read FInterfaceType; + + property PropertyCount: Integer read GetPropertyCount; + property Properties[Index: Integer]: TXMLDataBindingProperty read GetProperties; + end; + + + TXMLDataBindingCollection = class(TXMLDataBindingItem) + private + FCollectionItem: TXMLDataBindingInterface; + protected + function GetItemType(): TXMLDataBindingItemType; override; + public + constructor Create(ASchemaItem: IXMLSchemaItem; ACollectionItem: TXMLDataBindingInterface; const AName: String); + + property CollectionItem: TXMLDataBindingInterface read FCollectionItem; + end; + + + TXMLDataBindingEnumerationMember = class(TXMLDataBindingItem) + private + FEnumeration: TXMLDataBindingEnumeration; + protected + function GetItemType(): TXMLDataBindingItemType; override; + public + constructor Create(AEnumeration: TXMLDataBindingEnumeration; const AName: String); + + property Enumeration: TXMLDataBindingEnumeration read FEnumeration; + end; + + + TXMLDataBindingEnumeration = class(TXMLDataBindingItem) + private + FDataType: IXMLTypeDef; + FMembers: TObjectList; + + function GetMemberCount(): Integer; + function GetMembers(Index: Integer): TXMLDataBindingEnumerationMember; + protected + function GetItemType(): TXMLDataBindingItemType; override; + public + constructor Create(ASchemaItem: IXMLSchemaItem; ADataType: IXMLTypeDef; const AName: String); + destructor Destroy(); override; + + property DataType: IXMLTypeDef read FDataType; + property MemberCount: Integer read GetMemberCount; + property Members[Index: Integer]: TXMLDataBindingEnumerationMember read GetMembers; + end; + + + TXMLDataBindingProperty = class(TXMLDataBindingItem) + private + FIsOptional: Boolean; + protected + function GetIsReadOnly(): Boolean; virtual; abstract; + + function GetItemType(): TXMLDataBindingItemType; override; + function GetPropertyType(): TXMLDataBindingPropertyType; virtual; abstract; + public + property IsOptional: Boolean read FIsOptional write FIsOptional; + property IsReadOnly: Boolean read GetIsReadOnly; + property PropertyType: TXMLDataBindingPropertyType read GetPropertyType; + end; + + + TXMLDataBindingSimpleProperty = class(TXMLDataBindingProperty) + private + FDataType: IXMLTypeDef; + protected + function GetIsReadOnly(): Boolean; override; + function GetPropertyType(): TXMLDataBindingPropertyType; override; + public + constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String; ADataType: IXMLTypeDef); + + property DataType: IXMLTypeDef read FDataType; + end; + + + TXMLDataBindingItemProperty = class(TXMLDataBindingProperty) + private + FItem: TXMLDataBindingItem; + + function GetItem(): TXMLDataBindingItem; + protected + function GetIsReadOnly(): Boolean; override; + function GetPropertyType(): TXMLDataBindingPropertyType; override; + public + constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String; AItem: TXMLDataBindingItem); + + property Item: TXMLDataBindingItem read GetItem; + end; + + + TXMLDataBindingForwardItem = class(TXMLDataBindingItem) + private + FItem: TXMLDataBindingItem; + FInterfaceType: TXMLDataBindingInterfaceType; + protected + function GetItemType(): TXMLDataBindingItemType; override; + public + constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType); + + property InterfaceType: TXMLDataBindingInterfaceType read FInterfaceType; + property Item: TXMLDataBindingItem read FItem write FItem; end; implementation uses SysUtils, - + Windows, XMLDoc, - XMLIntf; + XMLIntf, + + X2UtHashes; + + +const + MaxOccursUnbounded = 'unbounded'; + + + +function GetInterfaceType(ASchemaItem: IXMLSchemaItem): TXMLDataBindingInterfaceType; +begin + if Supports(ASchemaItem, IXMLComplexTypeDef) then + Result := ifComplexType + else + Result := ifElement; +end; { TXMLDataBindingGenerator } @@ -86,15 +324,35 @@ end; procedure TXMLDataBindingGenerator.Execute(const AStream: TStream; const ASchemaName: String); -//var -// schemaIndex: Integer; -// +var + schemaIndex: Integer; + begin FSchemas.Clear(); LoadSchema(AStream, ASchemaName); if SchemaCount > 0 then + begin + { Map schema elements to objects } + for schemaIndex := 0 to Pred(SchemaCount) do + GenerateSchemaObjects(Schemas[schemaIndex], (schemaIndex = 0)); + + + { Process unresolved references } + for schemaIndex := 0 to Pred(SchemaCount) do + ResolveSchema(Schemas[schemaIndex]); + + ResolveNameConflicts(); + + + { Perform output-specific translations } + for schemaIndex := 0 to Pred(SchemaCount) do + TranslateSchema(Schemas[schemaIndex]); + + + { Output } GenerateDataBinding(); + end; end; @@ -124,11 +382,13 @@ end; -function TXMLDataBindingGenerator.LoadSchema(const AStream: TStream; const ASchemaName: String): IXMLSchemaDef; +function TXMLDataBindingGenerator.LoadSchema(const AStream: TStream; const ASchemaName: String): TXMLDataBindingSchema; - procedure HandleDocRefs(const ADocRefs: IXMLSchemaDocRefs); + procedure HandleDocRefs(const ADocRefs: IXMLSchemaDocRefs; ASchema: TXMLDataBindingSchema); var location: String; + schemaName: String; + refSchema: TXMLDataBindingSchema; refIndex: Integer; refStream: TStream; @@ -136,44 +396,48 @@ function TXMLDataBindingGenerator.LoadSchema(const AStream: TStream; const ASche for refIndex := 0 to Pred(ADocRefs.Count) do begin location := ADocRefs[refIndex].SchemaLocation; + schemaName := ChangeFileExt(ExtractFileName(location), ''); + refSchema := FindSchema(schemaName); - if not SchemaLoaded(ChangeFileExt(location, '')) then + if not Assigned(refSchema) then begin - refStream := FindSchema(location); + refStream := GetSchemaData(location); if Assigned(refStream) then try - location := ChangeFileExt(ExtractFileName(location), ''); - LoadSchema(refStream, location); + refSchema := LoadSchema(refStream, schemaName); finally FreeAndNil(refStream); end; end; + + if Assigned(refSchema) then + ASchema.AddInclude(refSchema); end; end; var - schema: TXMLDataBindingSchema; schemaDoc: IXMLSchemaDoc; + schemaDef: IXMLSchemaDef; begin schemaDoc := TXMLSchemaDoc.Create(nil); schemaDoc.LoadFromStream(AStream); - Result := schemaDoc.SchemaDef; + schemaDef := schemaDoc.SchemaDef; - schema := TXMLDataBindingSchema.Create(); - schema.SchemaDef := Result; - schema.SchemaName := ASchemaName; - FSchemas.Add(schema); + Result := TXMLDataBindingSchema.Create(); + Result.SchemaDef := schemaDef; + Result.SchemaName := ASchemaName; + FSchemas.Add(Result); { Handle imports / includes } - HandleDocRefs(Result.SchemaImports); - HandleDocRefs(Result.SchemaIncludes); + HandleDocRefs(schemaDef.SchemaImports, Result); + HandleDocRefs(schemaDef.SchemaIncludes, Result); end; -function TXMLDataBindingGenerator.FindSchema(const ALocation: String): TStream; +function TXMLDataBindingGenerator.GetSchemaData(const ALocation: String): TStream; var includeIndex: Integer; includePath: String; @@ -196,32 +460,811 @@ begin end; -function TXMLDataBindingGenerator.SchemaLoaded(const ALocation: String): Boolean; +function TXMLDataBindingGenerator.FindSchema(const ALocation: String): TXMLDataBindingSchema; var schemaIndex: Integer; begin - Result := False; - + Result := nil; + for schemaIndex := 0 to Pred(SchemaCount) do - if Schema[schemaIndex].SchemaName = ALocation then + if Schemas[schemaIndex].SchemaName = ALocation then begin - Result := True; + Result := Schemas[schemaIndex]; break; end; end; +procedure TXMLDataBindingGenerator.GenerateSchemaObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean); +var + includeIndex: Integer; + +begin + if ASchema.ItemsGenerated then + exit; + + ASchema.ItemsGenerated := True; + + { First generate the objects for all includes and imports, so we can get + proper references. } + for includeIndex := 0 to Pred(ASchema.IncludeCount) do + GenerateSchemaObjects(ASchema.Includes[includeIndex], False); + + + GenerateElementObjects(ASchema, ARootDocument); + GenerateComplexTypeObjects(ASchema); +end; + + +procedure TXMLDataBindingGenerator.GenerateElementObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean); +var + schemaDef: IXMLSchemaDef; + elementIndex: Integer; + item: TXMLDataBindingItem; + +begin + schemaDef := ASchema.SchemaDef; + + for elementIndex := 0 to Pred(schemaDef.ElementDefs.Count) do + begin + item := ProcessElement(ASchema, schemaDef.ElementDefs[elementIndex]); + + if Assigned(item) and ARootDocument then + item.DocumentElement := True; + end; +end; + + +procedure TXMLDataBindingGenerator.GenerateComplexTypeObjects(ASchema: TXMLDataBindingSchema); +var + schemaDef: IXMLSchemaDef; + complexTypeIndex: Integer; + complexType: IXMLComplexTypeDef; + interfaceItem: TXMLDataBindingInterface; + elementIndex: Integer; + +begin + schemaDef := ASchema.SchemaDef; + + for complexTypeIndex := 0 to Pred(schemaDef.ComplexTypes.Count) do + begin + complexType := schemaDef.ComplexTypes[complexTypeIndex]; + interfaceItem := TXMLDataBindingInterface.Create(complexType, complexType.Name); + ASchema.AddItem(interfaceItem); + + for elementIndex := 0 to Pred(complexType.ElementDefs.Count) do + ProcessChildElement(ASchema, complexType.ElementDefs[elementIndex], interfaceItem); + end; +end; + + +function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem; +var + elementIndex: Integer; + enumerationObject: TXMLDataBindingEnumeration; + interfaceObject: TXMLDataBindingInterface; + +begin + Result := nil; + interfaceObject := nil; + + if Assigned(AElement.Ref) then + begin + { Find reference. If not found, mark as "resolve later". } + Result := FindInterface(ASchema, AElement.Ref.Name, ifElement); + + if not Assigned(Result) then + begin + Result := TXMLDataBindingForwardItem.Create(AElement, AElement.Ref.Name, ifElement); + ASchema.AddItem(Result); + end; + end else + begin + if (not AElement.DataType.IsAnonymous) and + (AElement.DataType.IsComplex) then + begin + { Find data type. If not found, mark as "resolve later". } + Result := FindInterface(ASchema, AElement.DataTypeName, ifComplexType); + + if not Assigned(Result) then + begin + Result := TXMLDataBindingForwardItem.Create(AElement, AElement.DataTypeName, ifComplexType); + ASchema.AddItem(Result); + end; + end; + + if not Assigned(Result) then + begin + if AElement.DataType.Enumerations.Count > 0 then + begin + { Enumeration } + enumerationObject := TXMLDataBindingEnumeration.Create(AElement, AElement.DataType, AElement.Name); + ASchema.AddItem(enumerationObject); + Result := enumerationObject; + end else if AElement.DataType.IsComplex then + begin + { Interface } + interfaceObject := TXMLDataBindingInterface.Create(AElement, AElement.Name); + if Assigned(AElement.DataType.BaseType) then + interfaceObject.BaseName := AElement.DataType.BaseTypeName; + + ASchema.AddItem(interfaceObject); + + Result := interfaceObject; + end; + + + for elementIndex := 0 to Pred(AElement.ChildElements.Count) do + ProcessChildElement(ASchema, AElement.ChildElements[elementIndex], interfaceObject); + end; + end; +end; + + +procedure TXMLDataBindingGenerator.ProcessChildElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef; AInterface: TXMLDataBindingInterface); +var + collectionObject: TXMLDataBindingCollection; + propertyType: TXMLDataBindingItem; + propertyItem: TXMLDataBindingProperty; + +begin + collectionObject := nil; + + + if Assigned(AInterface) then + begin + if (AElement.MaxOccurs = MaxOccursUnbounded) or + (AElement.MaxOccurs > 1) then + begin + { Collection } + collectionObject := FindCollection(ASchema, AElement.Name); + + if not Assigned(collectionObject) then + begin + collectionObject := TXMLDataBindingCollection.Create(AELement, AInterface, AElement.Name); + ASchema.AddItem(collectionObject); + end; + end; + end; + + + propertyType := ProcessElement(ASchema, AElement); + if Assigned(collectionObject) then + propertyType := collectionObject; + + + if Assigned(AInterface) then + begin + if Assigned(propertyType) then + propertyItem := TXMLDataBindingItemProperty.Create(AElement, + AElement.Name, + propertyType) + else + propertyItem := TXMLDataBindingSimpleProperty.Create(AElement, + AElement.Name, + AElement.DataType); + + propertyItem.IsOptional := (AElement.MinOccurs = 0); + AInterface.AddProperty(propertyItem); + end; +end; + + +function TXMLDataBindingGenerator.IterateSchemaItems(ASchema: TXMLDataBindingSchema; AIterateProc: TXMLDataBindingIterateItemsProc; AData: Pointer): TXMLDataBindingItem; +var + abort: Boolean; + itemIndex: Integer; + schemaItem: TXMLDataBindingItem; + includeIndex: Integer; + +begin + Result := nil; + abort := False; + + for itemIndex := 0 to Pred(ASchema.ItemCount) do + begin + schemaItem := ASchema.Items[itemIndex]; + + AIterateProc(schemaItem, AData, abort); + if abort then + begin + Result := schemaItem; + Break; + end; + end; + + if not Assigned(Result) then + begin + for includeIndex := 0 to Pred(ASchema.IncludeCount) do + begin + Result := IterateSchemaItems(ASchema.Includes[includeIndex], AIterateProc, AData); + if Assigned(Result) then + break; + end; + end; +end; + + + +type + PFindInterfaceInfo = ^TFindInterfaceInfo; + TFindInterfaceInfo = record + InterfaceType: TXMLDataBindingInterfaceType; + Name: String; + end; + + +procedure TXMLDataBindingGenerator.FindInterfaceProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean); +var + findInfo: PFindInterfaceInfo; + +begin + findInfo := PFindInterfaceInfo(AData); + AAbort := (AItem.ItemType = itInterface) and + (TXMLDataBindingInterface(AItem).InterfaceType = findInfo^.InterfaceType) and + (AItem.Name = findInfo^.Name); +end; + + +function TXMLDataBindingGenerator.FindInterface(ASchema: TXMLDataBindingSchema; const AName: String; AType: TXMLDataBindingInterfaceType): TXMLDataBindingInterface; +var + findInfo: TFindInterfaceInfo; + +begin + findInfo.InterfaceType := AType; + findInfo.Name := AName; + Result := TXMLDataBindingInterface(IterateSchemaItems(ASchema, FindInterfaceProc, @findInfo)); +end; + + +procedure TXMLDataBindingGenerator.FindEnumerationProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean); +begin + AAbort := (AItem.ItemType = itEnumeration) and + (AItem.Name = PChar(AData)); +end; + + +function TXMLDataBindingGenerator.FindEnumeration(ASchema: TXMLDataBindingSchema; const AName: String): TXMLDataBindingEnumeration; +begin + Result := TXMLDataBindingEnumeration(IterateSchemaItems(ASchema, FindEnumerationProc, PChar(AName))); +end; + + +procedure TXMLDataBindingGenerator.FindCollectionProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean); +begin + AAbort := (AItem.ItemType = itCollection) and + (AItem.Name = PChar(AData)); +end; + + +function TXMLDataBindingGenerator.FindCollection(ASchema: TXMLDataBindingSchema; const AName: String): TXMLDataBindingCollection; +begin + Result := TXMLDataBindingCollection(IterateSchemaItems(ASchema, FindCollectionProc, PChar(AName))); +end; + + + +procedure TXMLDataBindingGenerator.ResolveSchema(ASchema: TXMLDataBindingSchema); +var + itemIndex: Integer; + item: TXMLDataBindingItem; + forwardItem: TXMLDataBindingForwardItem; + referenceItem: TXMLDataBindingItem; + interfaceItem: TXMLDataBindingInterface; + +begin + for itemIndex := 0 to Pred(ASchema.ItemCount) do + begin + item := ASchema.Items[itemIndex]; + + case item.ItemType of + itInterface: + begin + { Resolve base interface } + interfaceItem := TXMLDataBindingInterface(item); + + if Length(interfaceItem.BaseName) > 0 then + interfaceItem.BaseItem := FindInterface(ASchema, interfaceItem.BaseName, ifComplexType); + end; + + itForward: + begin + { Resolve forwarded item } + forwardItem := TXMLDataBindingForwardItem(item); + referenceItem := FindInterface(ASchema, item.Name, forwardItem.InterfaceType); + + if (not Assigned(referenceItem)) and + (forwardItem.InterfaceType = ifElement) then + referenceItem := FindEnumeration(ASchema, item.Name); + + if Assigned(referenceItem) then + TXMLDataBindingForwardItem(item).Item := referenceItem; + end; + end; + end; +end; + + +procedure TXMLDataBindingGenerator.ResolveNameConflicts(); +var + itemNames: TX2SOHash; + + + procedure AddItem(AItem: TXMLDataBindingItem); + var + hashName: String; + items: TObjectList; + + begin + { Collections use the same Name as their items, differentiate + between them while determining conflicts. } + hashName := AItem.Name; + if AItem.ItemType = itCollection then + hashName := hashName + #1; + + if not itemNames.Exists(hashName) then + begin + items := TObjectList.Create(False); + itemNames[hashName] := items; + end else + items := TObjectList(itemNames[hashName]); + + items.Add(AItem); + end; + + + function ResolveItemNameConflict(AItem: TXMLDataBindingItem; ADepth: Integer; out ANewName: String): Boolean; + var + currentDepth: Integer; + parentNode: IXMLNode; + schemaItem: IXMLSchemaItem; + + begin + Result := False; + currentDepth := 0; + parentNode := AItem.SchemaItem; + ANewName := AItem.Name; + + while Assigned(parentNode) do + begin + parentNode := parentNode.ParentNode; + + if Assigned(parentNode) and + Supports(parentNode, IXMLSchemaItem, schemaItem) and + (Length(schemaItem.Name) > 0) then + begin + ANewName := schemaItem.Name + ANewName; + + Inc(currentDepth); + if currentDepth = ADepth then + begin + Result := True; + break; + end; + end; + end; + end; + + +var + schemaIndex: Integer; + schema: TXMLDataBindingSchema; + itemIndex: Integer; + items: TObjectList; + item: TXMLDataBindingItem; + depth: Integer; + newName: String; + resolved: Boolean; + +begin + itemNames := TX2SOHash.Create(True); + try + { Gather names } + for schemaIndex := 0 to Pred(SchemaCount) do + begin + schema := Schemas[schemaIndex]; + + for itemIndex := 0 to Pred(schema.ItemCount) do + begin + item := schema.Items[itemIndex]; + + if item.ItemType in [itInterface, itCollection, itEnumeration] then + AddItem(item); + end; + end; + + + { Find conflicts } + itemNames.First(); + + while itemNames.Next() do + begin + items := TObjectList(itemNames.CurrentValue); + + if items.Count > 1 then + begin + { Attempt to rename items } + for itemIndex := Pred(items.Count) downto 0 do + begin + item := TXMLDataBindingItem(items[itemIndex]); + newName := item.Name; + resolved := False; + depth := 1; + + while ResolveItemNameConflict(item, depth, newName) do + begin + if not itemNames.Exists(newName) then + begin + resolved := True; + break; + end else + Inc(depth); + end; + + if resolved then + begin + items.Delete(itemIndex); + + item.SetName(newName); + AddItem(item); + end; + end; + end; + end; + finally + FreeAndNil(itemNames); + end; +end; + + +procedure TXMLDataBindingGenerator.TranslateSchema(ASchema: TXMLDataBindingSchema); +var + itemIndex: Integer; + +begin + for itemIndex := 0 to Pred(ASchema.ItemCount) do + TranslateItem(ASchema.Items[itemIndex]); +end; + + +procedure TXMLDataBindingGenerator.TranslateItem(AItem: TXMLDataBindingItem); +var + interfaceItem: TXMLDataBindingInterface; + propertyIndex: Integer; + enumerationItem: TXMLDataBindingEnumeration; + memberIndex: Integer; + +begin + AItem.SetTranslatedName(TranslateItemName(AItem)); + + case AItem.ItemType of + itInterface: + begin + interfaceItem := TXMLDataBindingInterface(AItem); + + for propertyIndex := 0 to Pred(interfaceItem.PropertyCount) do + TranslateItem(interfaceItem.Properties[propertyIndex]); + end; + itEnumeration: + begin + enumerationItem := TXMLDataBindingEnumeration(AItem); + + for memberIndex := 0 to Pred(enumerationItem.MemberCount) do + TranslateItem(enumerationItem.Members[memberIndex]); + end; + end; +end; + + +function TXMLDataBindingGenerator.TranslateItemName(AItem: TXMLDataBindingItem): String; +begin + Result := AItem.Name; +end; + + function TXMLDataBindingGenerator.GetSchemaCount(): Integer; begin Result := FSchemas.Count; end; -function TXMLDataBindingGenerator.GetSchema(Index: Integer): TXMLDataBindingSchema; +function TXMLDataBindingGenerator.GetSchemas(Index: Integer): TXMLDataBindingSchema; begin Result := TXMLDataBindingSchema(FSchemas[Index]); end; + +{ TXMLDataBindingSchema } +constructor TXMLDataBindingSchema.Create(); +begin + inherited; + + FIncludes := TObjectList.Create(False); + FItems := TObjectList.Create(True); +end; + + +destructor TXMLDataBindingSchema.Destroy(); +begin + FreeAndNil(FItems); + FreeAndNil(FIncludes); + + inherited; +end; + + +procedure TXMLDataBindingSchema.AddInclude(ASchema: TXMLDataBindingSchema); +begin + if FIncludes.IndexOf(ASchema) = -1 then + FIncludes.Add(ASchema); +end; + + +procedure TXMLDataBindingSchema.AddItem(AItem: TXMLDataBindingItem); +begin + if FItems.IndexOf(AItem) = -1 then + FItems.Add(AItem); +end; + + +function TXMLDataBindingSchema.GetIncludeCount(): Integer; +begin + Result := FIncludes.Count; +end; + + +function TXMLDataBindingSchema.GetIncludes(Index: Integer): TXMLDataBindingSchema; +begin + Result := TXMLDataBindingSchema(FIncludes[Index]); +end; + + +function TXMLDataBindingSchema.GetItemCount(): Integer; +begin + Result := FItems.Count; +end; + + +function TXMLDataBindingSchema.GetItems(Index: Integer): TXMLDataBindingItem; +begin + Result := TXMLDataBindingItem(FItems[Index]); +end; + + +{ TXMLDataBindingItem } +constructor TXMLDataBindingItem.Create(ASchemaItem: IXMLSchemaItem; const AName: String); +begin + inherited Create(); + + FName := AName; + FSchemaItem := ASchemaItem; + FTranslatedName := AName; +end; + + +function TXMLDataBindingItem.GetDocumentation(): String; +var + documentationIndex: Integer; + +begin + Result := ''; + if HasDocumentation then + begin + for documentationIndex := 0 to Pred(SchemaItem.Documentation.Count) do + Result := Result + SchemaItem.Documentation[documentationIndex].Text + #13#10; + + Result := Trim(Result); + end; +end; + + +function TXMLDataBindingItem.GetHasDocumentation: Boolean; +begin + Result := Assigned(SchemaItem) and + (SchemaItem.Documentation.Count > 0); +end; + +procedure TXMLDataBindingItem.SetName(const Value: String); +begin + FName := Value; +end; + + +procedure TXMLDataBindingItem.SetTranslatedName(const Value: string); +begin + FTranslatedName := Value; +end; + + +{ TXMLDataBindingInterface } +constructor TXMLDataBindingInterface.Create(ASchemaItem: IXMLSchemaItem; const AName: String); +begin + inherited Create(ASchemaItem, AName); + + FProperties := TObjectList.Create(True); + FInterfaceType := GetInterfaceType(SchemaItem); +end; + + +destructor TXMLDataBindingInterface.Destroy; +begin + FreeAndNil(FProperties); + + inherited; +end; + + +procedure TXMLDataBindingInterface.AddProperty(AProperty: TXMLDataBindingProperty); +begin + FProperties.Add(AProperty); +end; + + +function TXMLDataBindingInterface.GetItemType(): TXMLDataBindingItemType; +begin + Result := itInterface; +end; + + +function TXMLDataBindingInterface.GetPropertyCount(): Integer; +begin + Result := FProperties.Count; +end; + + +function TXMLDataBindingInterface.GetProperties(Index: Integer): TXMLDataBindingProperty; +begin + Result := TXMLDataBindingProperty(FProperties[Index]); +end; + + +{ TXMLDataBindingCollection } +constructor TXMLDataBindingCollection.Create(ASchemaItem: IXMLSchemaItem; ACollectionItem: TXMLDataBindingInterface; const AName: String); +begin + inherited Create(ASchemaItem, AName); + + FCollectionItem := ACollectionItem; +end; + + +function TXMLDataBindingCollection.GetItemType(): TXMLDataBindingItemType; +begin + Result := itCollection; +end; + + +{ TXMLDataBindingEnumerationMember } +constructor TXMLDataBindingEnumerationMember.Create(AEnumeration: TXMLDataBindingEnumeration; const AName: String); +begin + inherited Create(nil, AName); + + FEnumeration := AEnumeration; +end; + + +function TXMLDataBindingEnumerationMember.GetItemType(): TXMLDataBindingItemType; +begin + Result := itEnumerationMember; +end; + + +{ TXMLDataBindingEnumeration } +constructor TXMLDataBindingEnumeration.Create(ASchemaItem: IXMLSchemaItem; ADataType: IXMLTypeDef; const AName: String); +var + memberIndex: Integer; + +begin + inherited Create(ASchemaItem, AName); + + FDataType := ADataType; + FMembers := TObjectList.Create(); + + for memberIndex := 0 to Pred(ADataType.Enumerations.Count) do + FMembers.Add(TXMLDataBindingEnumerationMember.Create(Self, ADataType.Enumerations.Items[memberIndex].Value)); +end; + + +destructor TXMLDataBindingEnumeration.Destroy(); +begin + FreeAndNil(FMembers); + + inherited; +end; + + +function TXMLDataBindingEnumeration.GetItemType(): TXMLDataBindingItemType; +begin + Result := itEnumeration; +end; + + +function TXMLDataBindingEnumeration.GetMemberCount(): Integer; +begin + Result := FMembers.Count; +end; + + +function TXMLDataBindingEnumeration.GetMembers(Index: Integer): TXMLDataBindingEnumerationMember; +begin + Result := TXMLDataBindingEnumerationMember(FMembers[Index]); +end; + + +{ TXMLDataBindingProperty } +function TXMLDataBindingProperty.GetItemType(): TXMLDataBindingItemType; +begin + Result := itProperty; +end; + + +{ TXMLDataBindingSimpleProperty } +constructor TXMLDataBindingSimpleProperty.Create(ASchemaItem: IXMLSchemaItem; const AName: String; ADataType: IXMLTypeDef); +begin + inherited Create(ASchemaItem, AName); + + FDataType := ADataType; +end; + + +function TXMLDataBindingSimpleProperty.GetIsReadOnly(): Boolean; +begin + Result := False; +end; + + +function TXMLDataBindingSimpleProperty.GetPropertyType(): TXMLDataBindingPropertyType; +begin + Result := ptSimple; +end; + + +{ TXMLDataBindingItemProperty } +constructor TXMLDataBindingItemProperty.Create(ASchemaItem: IXMLSchemaItem; const AName: String; AItem: TXMLDataBindingItem); +begin + inherited Create(ASchemaItem, AName); + + FItem := AItem; +end; + + +function TXMLDataBindingItemProperty.GetIsReadOnly(): Boolean; +begin + Result := Assigned(Item) and (Item.ItemType <> itEnumeration); +end; + + +function TXMLDataBindingItemProperty.GetPropertyType(): TXMLDataBindingPropertyType; +begin + Result := ptItem; +end; + + +function TXMLDataBindingItemProperty.GetItem(): TXMLDataBindingItem; +begin + Result := FItem; + + while Assigned(Result) and (Result.ItemType = itForward) do + Result := TXMLDataBindingForwardItem(Result).Item; +end; + + +{ TXMLDataBindingForwardItem } +constructor TXMLDataBindingForwardItem.Create(ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType); +begin + inherited Create(ASchemaItem, AName); + + FInterfaceType := AInterfaceType; +end; + + +function TXMLDataBindingForwardItem.GetItemType(): TXMLDataBindingItemType; +begin + Result := itForward; +end; + end. + + + diff --git a/Units/XMLDataBindingHelpers.pas b/Units/XMLDataBindingHelpers.pas index 473b1dc..524bb0f 100644 --- a/Units/XMLDataBindingHelpers.pas +++ b/Units/XMLDataBindingHelpers.pas @@ -21,6 +21,9 @@ type procedure Write(const ASource: String); procedure WriteLn(const ASource: String = ''); + procedure WriteFmt(const ASource: String; const AParams: array of const); + procedure WriteLnFmt(const ASource: String; const AParams: array of const); + procedure WriteString(const ASource: String); procedure WriteInteger(const ASource: Integer); procedure WriteDateTime(const ASource: TDateTime); @@ -97,6 +100,18 @@ begin end; +procedure TStreamHelper.WriteFmt(const ASource: String; const AParams: array of const); +begin + Write(Format(ASource, AParams)); +end; + + +procedure TStreamHelper.WriteLnFmt(const ASource: String; const AParams: array of const); +begin + WriteLn(Format(ASource, AParams)); +end; + + procedure TStreamHelper.WriteString(const ASource: String); var iSize: Integer; @@ -126,3 +141,5 @@ begin end; end. + + diff --git a/X2XMLDataBinding.cfg b/X2XMLDataBinding.cfg new file mode 100644 index 0000000..957a33c --- /dev/null +++ b/X2XMLDataBinding.cfg @@ -0,0 +1,40 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-GD +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl" +-LN"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl" +-DmadExcept +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST diff --git a/X2XMLDataBindingCmdLine.bdsproj b/X2XMLDataBindingCmdLine.bdsproj new file mode 100644 index 0000000..034279f --- /dev/null +++ b/X2XMLDataBindingCmdLine.bdsproj @@ -0,0 +1,170 @@ + + + + + + + + + + + + X2XMLDataBindingCmdLine.dpr + + + 7.0 + + + 8 + 0 + 0 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 2 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + True + True + True + + + + 3 + 0 + False + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + Lib + + + + vcl;rtl;vclx;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;vcldb;dsnapcon;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;CLXIB;ibxpress;VCLIB;teeui;teedb;tee;dss;vclactnband;vclshlctrls;dclOfficeXP;Indy70;cxLibraryVCLD7;dxBarD7;dxComnD7;dxBarDBNavD7;dxBarExtDBItemsD7;dxBarExtItemsD7;dxDockingD7;dxsbD7;cxEditorsVCLD7;dxThemeD7;cxDataD7;cxExtEditorsVCLD7;cxPageControlVCLD7;cxGridVCLD7;cxSchedulerVCLD7;cxTreeListVCLD7;cxVerticalGridVCLD7;cxSpreadSheetVCLD7;dxNavBarD7;cxWebD7;cxWebPascalScriptD7;cxWebSnapD7;cxWebTeeChartD7;dxMasterViewD7;dxmdsD7;dxdbtrD7;dxtrmdD7;dxorgcD7;dxdborD7;dxFlowChartD7;dxLayoutControlD7;dxLayoutControlcxEditAdaptersD7;dxPSCoreD7;dxPSTeeChartD7;dxPsPrVwAdvD7;dxPSLnksD7;dxPSdxOCLnkD7;dxPSdxMVLnkD7;dxPSdxLCLnkD7;dxPSdxFCLnkD7;dxPSdxDBTVLnkD7;dxPSdxDBOCLnkD7;dxPSDBTeeChartD7;dxPScxCommonD7;dxPScxTLLnkD7;dxPScxSSLnkD7;dxPScxPCProdD7;dxPScxGridLnkD7;dxPScxExtCommonD7;dxPScxVGridLnkD7;fo_d7;xtx_d7;Rave50CLX;Rave50VCL;pngimaged7;dxGDIPlusD7;UnRegDxPNG + + + False + + + "F:\XTxXSD\Offerte.xsd" "F:\XTxXSD\Output\xml_Offerte.pas" + + + False + + + True + False + + + False + False + 0 + 0 + 0 + 0 + False + False + False + False + False + 1043 + 1252 + + + + + 0.0.0.0 + + + + + + + + + + diff --git a/X2XMLDataBindingCmdLine.cfg b/X2XMLDataBindingCmdLine.cfg new file mode 100644 index 0000000..8a733fd --- /dev/null +++ b/X2XMLDataBindingCmdLine.cfg @@ -0,0 +1,40 @@ +-$A8 +-$B- +-$C- +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O- +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$Y+ +-$Z1 +-GD +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-N0"Lib" +-LE"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl" +-LN"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST diff --git a/X2XMLDataBindingCmdLine.dof b/X2XMLDataBindingCmdLine.dof new file mode 100644 index 0000000..dade2ea --- /dev/null +++ b/X2XMLDataBindingCmdLine.dof @@ -0,0 +1,145 @@ +[FileVersion] +Version=7.0 +[Compiler] +A=8 +B=0 +C=0 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=0 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=2 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=0 +UnsafeCode=0 +UnsafeCast=0 +[Linker] +MapFile=3 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir= +UnitOutputDir=Lib +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath= +Packages=vcl;rtl;vclx;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;vcldb;dsnapcon;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;CLXIB;ibxpress;VCLIB;teeui;teedb;tee;dss;vclactnband;vclshlctrls;dclOfficeXP;Indy70;cxLibraryVCLD7;dxBarD7;dxComnD7;dxBarDBNavD7;dxBarExtDBItemsD7;dxBarExtItemsD7;dxDockingD7;dxsbD7;cxEditorsVCLD7;dxThemeD7;cxDataD7;cxExtEditorsVCLD7;cxPageControlVCLD7;cxGridVCLD7;cxSchedulerVCLD7;cxTreeListVCLD7;cxVerticalGridVCLD7;cxSpreadSheetVCLD7;dxNavBarD7;cxWebD7;cxWebPascalScriptD7;cxWebSnapD7;cxWebTeeChartD7;dxMasterViewD7;dxmdsD7;dxdbtrD7;dxtrmdD7;dxorgcD7;dxdborD7;dxFlowChartD7;dxLayoutControlD7;dxLayoutControlcxEditAdaptersD7;dxPSCoreD7;dxPSTeeChartD7;dxPsPrVwAdvD7;dxPSLnksD7;dxPSdxOCLnkD7;dxPSdxMVLnkD7;dxPSdxLCLnkD7;dxPSdxFCLnkD7;dxPSdxDBTVLnkD7;dxPSdxDBOCLnkD7;dxPSDBTeeChartD7;dxPScxCommonD7;dxPScxTLLnkD7;dxPScxSSLnkD7;dxPScxPCProdD7;dxPScxGridLnkD7;dxPScxExtCommonD7;dxPScxVGridLnkD7;fo_d7;xtx_d7;Rave50CLX;Rave50VCL;pngimaged7;dxGDIPlusD7;UnRegDxPNG +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams="P:\xtx\xtx\xsd\Offerte.xsd" "P:\xtx\xtx\xsd\xml_Offerte.pas" +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir=C:\Program Files\Borland\Delphi7\Bin\ +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=0 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1043 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=0.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion= +Comments= +[Excluded Packages] +P:\Algemeen\bin\unageneral_d7_design.bpl=UnameIT's General Components - Design-time Editors +C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlUnitOutputDirectory] +Count=1 +Item0=Lib diff --git a/X2XMLDataBindingCmdLine.dpr b/X2XMLDataBindingCmdLine.dpr new file mode 100644 index 0000000..217299a --- /dev/null +++ b/X2XMLDataBindingCmdLine.dpr @@ -0,0 +1,24 @@ +program X2XMLDataBindingCmdLine; + +uses + ActiveX, + SysUtils, + DelphiXMLDataBindingGenerator in 'Units\DelphiXMLDataBindingGenerator.pas', + XMLDataBindingGenerator in 'Units\XMLDataBindingGenerator.pas', + XMLDataBindingHelpers in 'Units\XMLDataBindingHelpers.pas', + xml_Offerte in 'F:\XTxXSD\Output\xml_Offerte.pas'; + +begin + CoInitialize(nil); + + with TDelphiXMLDataBindingGenerator.Create() do + try + OutputType := otSingle; + OutputPath := ParamStr(2); + + Execute(ParamStr(1)); + finally + Free(); + end; +end. +