diff --git a/Tests/Data/02. Collection.xsd b/Tests/Data/02. Collection.xsd index 7bdf83f..01e0f3d 100644 --- a/Tests/Data/02. Collection.xsd +++ b/Tests/Data/02. Collection.xsd @@ -23,6 +23,15 @@ + + + + + + + + + diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas index 65423c4..7fed9e0 100644 --- a/Units/DelphiXMLDataBindingGenerator.pas +++ b/Units/DelphiXMLDataBindingGenerator.pas @@ -3,6 +3,7 @@ unit DelphiXMLDataBindingGenerator; interface uses Classes, + Contnrs, XMLSchema, X2UtHashes, @@ -11,19 +12,32 @@ uses XMLDataBindingGenerator, XMLDataBindingHelpers; - + type TGetFileNameEvent = procedure(Sender: TObject; const SchemaName: String; var Path, FileName: String) of object; - + + TXMLSchemaList = class(TObjectList) + private + function GetItem(Index: Integer): TXMLDataBindingSchema; + procedure SetItem(Index: Integer; const Value: TXMLDataBindingSchema); + public + constructor Create(); + + property Items[Index: Integer]: TXMLDataBindingSchema read GetItem write SetItem; default; + end; + + TDelphiXMLDataBindingGenerator = class(TXMLDataBindingGenerator) private - FOnGetFileName: TGetFileNameEvent; - FProcessedItems: TX2OIHash; + FProcessedItems: TX2OIHash; + FUnitNames: TX2OSHash; + + FOnGetFileName: TGetFileNameEvent; protected procedure GenerateDataBinding(); override; - procedure GenerateSingleDataBinding(); - procedure GenerateMultipleDataBinding(); + procedure GenerateOutputFile(ASchemaList: TXMLSchemaList; const ASourceFileName, AUnitName: String); + function GenerateUsesClause(ASchemaList: TXMLSchemaList): String; function DelphiSafeName(const AName: String): String; function TranslateItemName(AItem: TXMLDataBindingItem): String; override; @@ -32,37 +46,41 @@ type function GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean; + function GetDataTypeName(AProperty: TXMLDataBindingProperty; AInterfaceName: Boolean): String; function TranslateDataType(ADataType: IXMLTypeDef): String; function CreateNewGUID(): String; - procedure WriteUnitHeader(AStream: TStreamHelper; const AFileName: String); - procedure WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection); - procedure WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection); - procedure WriteEnumerationConstants(AStream: TStreamHelper); - procedure WriteEnumerationConversions(AStream: TStreamHelper); + procedure WriteUnitHeader(AStream: TStreamHelper; const ASourceFileName, AFileName: String); + procedure WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList); + procedure WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList); + procedure WriteEnumerationConversions(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList); + procedure WriteConversionHelpers(AStream: TStreamHelper; ASchemaList: TXMLSchemaList); procedure WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem); + procedure WriteAfterConstruction(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection); + function WriteInlineCollectionFields(AStream: TStreamHelper; AItem: TXMLDataBindingInterface): Boolean; 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); + function WriteSchemaInterfaceCollectionProperties(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection): Boolean; + function WriteSchemaInterfaceProperty(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; AProperty: TXMLDataBindingProperty; ASection: TDelphiXMLSection; AMember: TDelphiXMLMember; ANewLine: Boolean): Boolean; procedure WriteSchemaEnumeration(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration; ASection: TDelphiXMLSection); procedure WriteSchemaEnumerationArray(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration); - function DataTypeConversion(const ADestination, ASource: string; ADataType: IXMLTypeDef; AToNative: Boolean; const ALinesBefore: string = ''): string; - function XMLToNativeDataType(const ADestination, ASource: string; ADataType: IXMLTypeDef; const ALinesBefore: string = ''): string; - function NativeDataTypeToXML(const ADestination, ASource: string; ADataType: IXMLTypeDef; const ALinesBefore: string = ''): string; + function GetDelphiNodeType(AProperty: TXMLDataBindingProperty): TDelphiNodeType; + function DataTypeConversion(const ADestination, ASource: String; ADataType: IXMLTypeDef; AAccessor: TDelphiAccessor; ANodeType: TDelphiNodeType; const ALinesBefore: String = ''): String; + function XMLToNativeDataType(const ADestination, ASource: String; ADataType: IXMLTypeDef; ANodeType: TDelphiNodeType; const ALinesBefore: String = ''): String; + function NativeDataTypeToXML(const ADestination, ASource: String; ADataType: IXMLTypeDef; ANodeType: TDelphiNodeType; const ALinesBefore: String = ''): String; property ProcessedItems: TX2OIHash read FProcessedItems; + property UnitNames: TX2OSHash read FUnitNames; public property OnGetFileName: TGetFileNameEvent read FOnGetFileName write FOnGetFileName; end; - + implementation uses - Contnrs, SysUtils, X2UtNamedFormat; @@ -71,49 +89,95 @@ uses { TDelphiXMLDataBindingGenerator } procedure TDelphiXMLDataBindingGenerator.GenerateDataBinding(); +var + schemaList: TXMLSchemaList; + schemaIndex: Integer; + schema: TXMLDataBindingSchema; + unitName: String; + begin - case OutputType of - otSingle: GenerateSingleDataBinding(); - otMultiple: GenerateMultipleDataBinding(); + schemaList := TXMLSchemaList.Create(); + try + case OutputType of + otSingle: + begin + for schemaIndex := 0 to Pred(SchemaCount) do + schemaList.Add(Schemas[schemaIndex]); + + unitName := DoGetFileName(Schemas[0].SchemaName); + GenerateOutputFile(schemaList, SourceFileName, unitName); + end; + + otMultiple: + begin + FUnitNames := TX2OSHash.Create(); + try + for schemaIndex := 0 to Pred(SchemaCount) do + begin + schema := Schemas[schemaIndex]; + FUnitNames[schema] := DoGetFileName(schema.SchemaName); + end; + + for schemaIndex := 0 to Pred(SchemaCount) do + begin + schema := Schemas[schemaIndex]; + + schemaList.Clear(); + schemaList.Add(schema); + + unitName := FUnitNames[schema]; + GenerateOutputFile(schemaList, schema.SourceFileName, unitName); + end; + finally + FreeAndNil(FUnitNames); + end; + end; + end; + finally + FreeAndNil(schemaList); end; end; -procedure TDelphiXMLDataBindingGenerator.GenerateSingleDataBinding(); +procedure TDelphiXMLDataBindingGenerator.GenerateOutputFile(ASchemaList: TXMLSchemaList; const ASourceFileName, AUnitName: String); var - unitName: String; - unitStream: TStreamHelper; + unitStream: TStreamHelper; + usesClause: String; begin - unitName := DoGetFileName(Schemas[0].SchemaName); - unitStream := TStreamHelper.Create(TFileStream.Create(unitName, fmCreate), soOwned); - try - WriteUnitHeader(unitStream, unitName); + usesClause := ''; - unitStream.Write(UnitInterface); - WriteSection(unitStream, dxsForward); + if OutputType = otMultiple then + usesClause := GenerateUsesClause(ASchemaList); + + unitStream := TStreamHelper.Create(TFileStream.Create(AUnitName, fmCreate), soOwned); + try + WriteUnitHeader(unitStream, ASourceFileName, AUnitName); + + unitStream.WriteNamedFmt(UnitInterface, + ['UsesClause', usesClause]); + WriteSection(unitStream, dxsForward, ASchemaList); FProcessedItems := TX2OIHash.Create(); try FProcessedItems.Clear(); - WriteSection(unitStream, dxsInterface); + WriteSection(unitStream, dxsInterface, ASchemaList); FProcessedItems.Clear(); - WriteSection(unitStream, dxsClass); + WriteSection(unitStream, dxsClass, ASchemaList); finally FreeAndNil(FProcessedItems); end; - WriteDocumentFunctions(unitStream, dxsInterface); - WriteEnumerationConstants(unitStream); + WriteDocumentFunctions(unitStream, dxsInterface, ASchemaList); + WriteEnumerationConversions(unitStream, dxsInterface, ASchemaList); unitStream.Write(UnitImplementation); - WriteDocumentFunctions(unitStream, dxsImplementation); - WriteEnumerationConversions(unitStream); + WriteDocumentFunctions(unitStream, dxsImplementation, ASchemaList); + WriteEnumerationConversions(unitStream, dxsImplementation, ASchemaList); + WriteConversionHelpers(unitStream, ASchemaList); - // #ToDo1 (MvR) 20-3-2008: write conversion methods - - WriteSection(unitStream, dxsImplementation); + WriteSection(unitStream, dxsImplementation, ASchemaList); unitStream.Write(unitFooter); finally @@ -122,15 +186,79 @@ begin end; -procedure TDelphiXMLDataBindingGenerator.GenerateMultipleDataBinding(); +function TDelphiXMLDataBindingGenerator.GenerateUsesClause(ASchemaList: TXMLSchemaList): String; +var + includedSchemas: TObjectList; + + procedure AddSchema(ASchema: TXMLDataBindingSchema); + begin + if Assigned(ASchema) and + (includedSchemas.IndexOf(ASchema) = -1) and + (ASchemaList.IndexOf(ASchema) = -1) then + includedSchemas.Add(ASchema); + end; + + +var + schemaIndex: Integer; + schema: TXMLDataBindingSchema; + itemIndex: Integer; + interfaceItem: TXMLDataBindingInterface; + propertyIndex: Integer; + propertyItem: TXMLDataBindingProperty; + includeIndex: Integer; + begin + Result := ''; + + includedSchemas := TObjectList.Create(False); + try + { Determine which items are used } + for schemaIndex := 0 to Pred(ASchemaList.Count) do + begin + schema := ASchemaList[schemaIndex]; + + for itemIndex := 0 to Pred(schema.ItemCount) do + begin + if schema.Items[itemIndex].ItemType = itInterface then + begin + interfaceItem := TXMLDataBindingInterface(schema.Items[itemIndex]); + + if Assigned(interfaceItem.CollectionItem) then + AddSchema(interfaceItem.CollectionItem.Schema); + + for propertyIndex := 0 to Pred(interfaceItem.PropertyCount) do + begin + propertyItem := interfaceItem.Properties[propertyIndex]; + + if propertyItem.PropertyType = ptItem then + AddSchema(TXMLDataBindingItemProperty(propertyItem).Item.Schema); + end; + end; + end; + end; + + { Build uses clause } + if includedSchemas.Count > 0 then + begin + for includeIndex := 0 to Pred(includedSchemas.Count) do + begin + schema := TXMLDataBindingSchema(includedSchemas[includeIndex]); + Result := Result + ' ' + ChangeFileExt(ExtractFileName(FUnitNames[schema]), '') + ',' + CrLf; + end; + + Result := Result + CrLf; + end; + finally + FreeAndNil(includedSchemas); + end; end; function TDelphiXMLDataBindingGenerator.GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean; var mappingIndex: Integer; - dataTypeName: string; + dataTypeName: String; begin Assert(not ADataType.IsComplex, 'Complex DataTypes not supported'); @@ -154,10 +282,33 @@ begin end; +function TDelphiXMLDataBindingGenerator.GetDataTypeName(AProperty: TXMLDataBindingProperty; AInterfaceName: Boolean): String; +var + item: TXMLDataBindingItem; + +begin + case AProperty.PropertyType of + ptSimple: + Result := TranslateDataType(TXMLDataBindingSimpleProperty(AProperty).DataType); + ptItem: + begin + item := TXMLDataBindingItemProperty(AProperty).Item; + + if (item.ItemType = itEnumeration) or (not AInterfaceName) then + Result := PrefixClass + else + Result := PrefixInterface; + + Result := Result + item.TranslatedName; + end; + end; +end; + + function TDelphiXMLDataBindingGenerator.TranslateDataType(ADataType: IXMLTypeDef): String; var typeMapping: TTypeMapping; - + begin Result := 'Variant'; if GetDataTypeMapping(ADataType, typeMapping) then @@ -194,25 +345,24 @@ begin end; -procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; const AFileName: String); +procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; const ASourceFileName, AFileName: String); begin - // #ToDo3 (MvR) 14-4-2007: if outputtype = multiple, use include files AStream.WriteNamedFmt(UnitHeader, - ['SourceFileName', SourceFileName, + ['SourceFileName', ASourceFileName, 'UnitName', ChangeFileExt(ExtractFileName(AFileName), '')]); end; -procedure TDelphiXMLDataBindingGenerator.WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection); +procedure TDelphiXMLDataBindingGenerator.WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList); var schemaIndex: Integer; schema: TXMLDataBindingSchema; itemIndex: Integer; begin - for schemaIndex := 0 to Pred(SchemaCount) do + for schemaIndex := 0 to Pred(ASchemaList.Count) do begin - schema := Schemas[schemaIndex]; + schema := ASchemaList[schemaIndex]; AStream.WriteLnNamedFmt(SectionComments[ASection], ['SchemaName', schema.SchemaName]); @@ -224,7 +374,7 @@ begin end; -procedure TDelphiXMLDataBindingGenerator.WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection); +procedure TDelphiXMLDataBindingGenerator.WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList); var schemaIndex: Integer; schema: TXMLDataBindingSchema; @@ -236,9 +386,9 @@ var begin hasItem := False; - for schemaIndex := 0 to Pred(SchemaCount) do + for schemaIndex := 0 to Pred(ASchemaList.Count) do begin - schema := Schemas[schemaIndex]; + schema := ASchemaList[schemaIndex]; for itemIndex := 0 to Pred(schema.ItemCount) do begin @@ -284,25 +434,32 @@ begin AStream.WriteLn('const'); AStream.WriteLn(' TargetNamespace = '''';'); AStream.WriteLn(); + AStream.WriteLn(); end; end; -procedure TDelphiXMLDataBindingGenerator.WriteEnumerationConstants(AStream: TStreamHelper); +procedure TDelphiXMLDataBindingGenerator.WriteEnumerationConversions(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList); var - item: TXMLDataBindingItem; - itemIndex: Integer; - schema: TXMLDataBindingSchema; - schemaIndex: Integer; - enumerations: TObjectList; + enumerations: TObjectList; + schemaIndex: Integer; + schema: TXMLDataBindingSchema; + itemIndex: Integer; + item: TXMLDataBindingItem; + enumerationItem: TXMLDataBindingEnumeration; + sourceCode: TNamedFormatStringList; + indent: String; begin - { Write array constants for enumerations } + if not (ASection in [dxsInterface, dxsImplementation]) then + Exit; + + enumerations := TObjectList.Create(False); try - for schemaIndex := 0 to Pred(SchemaCount) do + for schemaIndex := 0 to Pred(ASchemaList.Count) do begin - schema := Schemas[schemaIndex]; + schema := ASchemaList[schemaIndex]; for itemIndex := 0 to Pred(schema.ItemCount) do begin @@ -313,12 +470,63 @@ begin end; end; + if enumerations.Count > 0 then begin - AStream.WriteLn('const'); + if ASection = dxsInterface then + begin + { Enumeration value arrays } + AStream.WriteLn('const'); - for itemIndex := 0 to Pred(enumerations.Count) do - WriteSchemaEnumerationArray(AStream, TXMLDataBindingEnumeration(enumerations[itemIndex])); + for itemIndex := 0 to Pred(enumerations.Count) do + WriteSchemaEnumerationArray(AStream, TXMLDataBindingEnumeration(enumerations[itemIndex])); + end; + + + { Conversion helpers } + if ASection = dxsInterface then + AStream.Write(' '); + + AStream.WriteLn('{ Enumeration conversion helpers }'); + + + for itemIndex := Pred(enumerations.Count) downto 0 do + begin + enumerationItem := TXMLDataBindingEnumeration(enumerations[itemIndex]); + + indent := ''; + if ASection = dxsInterface then + indent := ' '; + + sourceCode := TNamedFormatStringList.Create(); + try + sourceCode.Add(indent + 'function StringTo%:s(const AValue: WideString): %:s;'); + + if ASection = dxsImplementation then + begin + sourceCode.Add('var'); + sourceCode.Add(' enumValue: %:s;'); + sourceCode.AddLn; + sourceCode.Add('begin'); + sourceCode.Add(' Result := %:s(-1);'); + sourceCode.Add(' for enumValue := Low(%:s) to High(%:s) do'); + sourceCode.Add(' if %:sValues[enumValue] = AValue then'); + sourceCode.Add(' begin'); + sourceCode.Add(' Result := enumValue;'); + sourceCode.Add(' break;'); + sourceCode.Add(' end;'); + sourceCode.Add('end;'); + sourceCode.AddLn; + end; + + AStream.Write(sourceCode.Format(['ItemName', enumerationItem.TranslatedName, + 'DataType', PrefixClass + enumerationItem.TranslatedName])); + finally + FreeAndNil(sourceCode); + end; + end; + + AStream.WriteLn; end; finally FreeAndNil(enumerations); @@ -326,25 +534,85 @@ begin end; -procedure TDelphiXMLDataBindingGenerator.WriteEnumerationConversions(AStream: TStreamHelper); +procedure TDelphiXMLDataBindingGenerator.WriteConversionHelpers(AStream: TStreamHelper; ASchemaList: TXMLSchemaList); +var + usedConversions: TTypeConversions; + schemaIndex: Integer; + schema: TXMLDataBindingSchema; + itemIndex: Integer; + interfaceItem: TXMLDataBindingInterface; + propertyIndex: Integer; + propertyItem: TXMLDataBindingSimpleProperty; + typeMapping: TTypeMapping; + conversion: TTypeConversion; + hasHelpers: Boolean; + begin - // + usedConversions := []; + + { Determine which conversions are used } + for schemaIndex := Pred(ASchemaList.Count) downto 0 do + begin + schema := ASchemaList[schemaIndex]; + + for itemIndex := Pred(schema.ItemCount) downto 0 do + begin + if schema.Items[itemIndex].ItemType = itInterface then + begin + interfaceItem := TXMLDataBindingInterface(schema.Items[itemIndex]); + + for propertyIndex := Pred(interfaceItem.PropertyCount) downto 0 do + begin + if interfaceItem.Properties[propertyIndex].PropertyType = ptSimple then + begin + propertyItem := TXMLDataBindingSimpleProperty(interfaceItem.Properties[propertyIndex]); + if GetDataTypeMapping(propertyItem.DataType, typeMapping) then + Include(usedConversions, typeMapping.Conversion); + end; + end; + end; + end; + end; + + + hasHelpers := False; + for conversion := Low(TTypeConversion) to High(TTypeConversion) do + if conversion in usedConversions then + begin + if Length(TypeConversionHelpers[conversion]) > 0 then + begin + if not hasHelpers then + AStream.WriteLn('{ Data type conversion helpers }'); + + AStream.Write(TypeConversionHelpers[conversion]); + hasHelpers := True; + end; + end; + + if hasHelpers then + AStream.WriteLn(); end; procedure TDelphiXMLDataBindingGenerator.WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem); var - lines: TStringList; - lineIndex: Integer; + documentation: String; + lineIndex: Integer; + lines: TStringList; 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); + documentation := AItem.Documentation; + + { Replace dangerous characters } + documentation := StringReplace(documentation, '{', '(', [rfReplaceAll]); + documentation := StringReplace(documentation, '}', ')', [rfReplaceAll]); + + lines.Text := WrapText(documentation, 76); AStream.WriteLn(' {'); for lineIndex := 0 to Pred(lines.Count) do @@ -361,7 +629,6 @@ procedure TDelphiXMLDataBindingGenerator.WriteSchemaItem(AStream: TStreamHelper; 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; @@ -390,13 +657,17 @@ begin dxsForward: AStream.WriteLnNamedFmt(InterfaceItemForward, ['Name', AItem.TranslatedName]); + dxsInterface: begin if Assigned(AItem.BaseItem) then parent := PrefixInterface + AItem.BaseItem.TranslatedName + else if AItem.IsCollection then + parent := CollectionInterface else parent := ItemInterface; + WriteDocumentation(AStream, AItem); AStream.WriteLnNamedFmt(InterfaceItemInterface, ['Name', AItem.TranslatedName, @@ -408,13 +679,17 @@ begin AStream.WriteLn(' end;'); AStream.WriteLn(); end; + dxsClass: begin if Assigned(AItem.BaseItem) then parent := PrefixClass + AItem.BaseItem.TranslatedName + else if AItem.IsCollection then + parent := CollectionClass else parent := ItemClass; + AStream.WriteLnNamedFmt(InterfaceItemClass, ['Name', AItem.TranslatedName, 'ParentName', parent]); @@ -424,6 +699,7 @@ begin AStream.WriteLn(' end;'); AStream.WriteLn(); end; + dxsImplementation: begin WriteSchemaInterfaceProperties(AStream, AItem, ASection); @@ -432,348 +708,207 @@ begin end; -procedure TDelphiXMLDataBindingGenerator.WriteSchemaInterfaceProperties(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection); +procedure TDelphiXMLDataBindingGenerator.WriteAfterConstruction(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection); +var + hasPrototype: Boolean; - procedure WriteAfterConstruction; - var - propertyIndex: Integer; - propertyItem: TXMLDataBindingProperty; - itemProperty: TXMLDataBindingItemProperty; - hasInterface: Boolean; + procedure WritePrototype(); begin - hasInterface := False; - - for propertyIndex := 0 to Pred(AItem.PropertyCount) do + if not hasPrototype then 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 TXML%s.AfterConstruction;', [AItem.TranslatedName]); - AStream.WriteLn('begin'); - hasInterface := True; - end; - - AStream.WriteLnNamedFmt(' RegisterChildNode(''%:s'', TXML%:s);', - ['SourceName', itemProperty.Item.Name, - 'Name', itemProperty.Item.TranslatedName]); - end; + case ASection of + dxsClass: + begin + AStream.WriteLn(' public'); + AStream.WriteLn(' procedure AfterConstruction; override;'); end; - end; - end; - end; - if (ASection = dxsImplementation) and hasInterface then - begin - AStream.WriteLn('end;'); - AStream.WriteLn(); + dxsImplementation: + begin + AStream.WriteLnFmt('procedure TXML%s.AfterConstruction;', [AItem.TranslatedName]); + AStream.WriteLn('begin'); + end; + end; + + hasPrototype := True; end; end; var - propertyIndex: Integer; - itemProperty: TXMLDataBindingProperty; - propertyItem: TXMLDataBindingItem; - dataTypeName: String; - writeOptional: Boolean; - writeTextProp: Boolean; - hasMembers: Boolean; - member: TDelphiXMLMember; - value: String; - sourceCode: TNamedFormatStringList; - propertyItemName: String; + itemProperty: TXMLDataBindingItemProperty; + propertyIndex: Integer; + propertyItem: TXMLDataBindingProperty; + +begin + if not (ASection in [dxsClass, dxsImplementation]) then + Exit; + + if (ASection = dxsClass) and + (not AItem.IsCollection) then + WriteInlineCollectionFields(AStream, AItem); + + + hasPrototype := False; + + for propertyIndex := 0 to Pred(AItem.PropertyCount) do + begin + propertyItem := AItem.Properties[propertyIndex]; + + if (not AItem.IsCollection) and Assigned(propertyItem.Collection) then + begin + WritePrototype; + + { Inline collection } + if ASection = dxsImplementation then + begin + AStream.WriteLnNamedFmt(' RegisterChildNode(''%:s'', %:s);', + ['ItemSourceName', propertyItem.Name, + 'ItemClass', PrefixClass + propertyItem.TranslatedName]); + + AStream.WriteLnNamedFmt(' %:s := CreateCollection(%:s, %:s, ''%:s'') as %:s;', + ['FieldName', PrefixField + propertyItem.TranslatedName, + 'CollectionClass', PrefixClass + propertyItem.Collection.TranslatedName, + 'CollectionInterface', PrefixInterface + propertyItem.Collection.TranslatedName, + 'ItemInterface', PrefixInterface + propertyItem.TranslatedName, + 'ItemSourceName', propertyItem.Name]); + end; + end else if (propertyItem.PropertyType = ptItem) and + ((not AItem.IsCollection) or + (propertyItem <> AItem.CollectionItem)) then + begin + { Item property } + itemProperty := TXMLDataBindingItemProperty(propertyItem); + + if Assigned(itemProperty.Item) and + (itemProperty.Item.ItemType = itInterface) then + begin + case ASection of + dxsClass: + WritePrototype; + + dxsImplementation: + begin + WritePrototype; + AStream.WriteLnNamedFmt(' RegisterChildNode(''%:s'', TXML%:s);', + ['SourceName', itemProperty.Item.Name, + 'Name', itemProperty.Item.TranslatedName]); + end; + end; + end; + end; + end; + + if AItem.IsCollection then + begin + WritePrototype; + + if ASection = dxsImplementation then + begin + WritePrototype; + AStream.WriteLnNamedFmt(' RegisterChildNode(''%:s'', %:s);', + ['SourceName', AItem.CollectionItem.Name, + 'DataClass', GetDataTypeName(AItem.CollectionItem, False)]); + AStream.WriteLn; + AStream.WriteLnFmt(' ItemTag := ''%s'';', [AItem.CollectionItem.Name]); + AStream.WriteLnFmt(' ItemInterface := %s;', [GetDataTypeName(AItem.CollectionItem, True)]); + AStream.WriteLn; + end; + end; + + if hasPrototype and (ASection = dxsImplementation) then + begin + AStream.WriteLn(' inherited;'); + AStream.WriteLn('end;'); + AStream.WriteLn; + end; +end; + + +function TDelphiXMLDataBindingGenerator.WriteInlineCollectionFields(AStream: TStreamHelper; AItem: TXMLDataBindingInterface): Boolean; +var + propertyIndex: Integer; + collectionProperty: TXMLDataBindingProperty; + +begin + Result := False; + + for propertyIndex := 0 to Pred(AItem.PropertyCount) do + if AItem.Properties[propertyIndex].IsRepeating then + begin + collectionProperty := AItem.Properties[propertyIndex]; + + if Assigned(collectionProperty.Collection) then + begin + if not Result then + begin + AStream.WriteLn(' private'); + Result := True; + end; + + AStream.WriteLnNamedFmt(' %:s: %:s;', + ['PropertyName', PrefixField + collectionProperty.TranslatedName, + 'DataInterface', PrefixInterface + collectionProperty.Collection.TranslatedName]); + end; + end; +end; + + +procedure TDelphiXMLDataBindingGenerator.WriteSchemaInterfaceProperties(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection); +var + propertyIndex: Integer; + itemProperty: TXMLDataBindingProperty; + hasMembers: Boolean; + firstMember: Boolean; + member: TDelphiXMLMember; begin - // #ToDo1 (MvR) 9-3-2008: refactor WriteSchemaInterfaceProperties if ASection = dxsForward then Exit; - if ASection = dxsImplementation then - WriteAfterConstruction(); + if ASection in [dxsClass, dxsImplementation] then + WriteAfterConstruction(AStream, AItem, ASection); if ASection = dxsClass then AStream.WriteLn(' protected'); - hasMembers := False; + hasMembers := WriteSchemaInterfaceCollectionProperties(AStream, AItem, ASection); + for member := Low(TDelphiXMLMember) to High(TDelphiXMLMember) do begin - if hasMembers then - AStream.WriteLn; - - hasMembers := False; + firstMember := True; for propertyIndex := 0 to Pred(AItem.PropertyCount) do begin itemProperty := AItem.Properties[propertyIndex]; - propertyItem := nil; - dataTypeName := ''; - writeTextProp := False; - writeOptional := True; - { 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; - - { Collections have a Count property, no need to write a - HasX property as well. } - writeOptional := (propertyItem.ItemType <> itCollection); - - dataTypeName := dataTypeName + propertyItem.TranslatedName; - end; - end; - end; - - - if Length(dataTypeName) > 0 then + if WriteSchemaInterfaceProperty(AStream, AItem, itemProperty, ASection, member, + hasMembers and firstMember and (ASection in [dxsInterface, dxsClass])) then begin - writeOptional := writeOptional and - itemProperty.IsOptional and - (member in [dxmPropertyGet, dxmPropertyDeclaration]); - - - sourceCode := TNamedFormatStringList.Create(); - try - case ASection of - dxsInterface, - dxsClass: - begin - { Interface declaration } - case member of - dxmPropertyGet: - begin - if writeOptional then - sourceCode.Add(PropertyIntfMethodGetOptional); - - if writeTextProp then - sourceCode.Add(PropertyIntfMethodGetText); - - sourceCode.Add(PropertyIntfMethodGet); - hasMembers := True; - end; - - dxmPropertySet: - if not itemProperty.IsReadOnly then - begin - if writeTextProp then - sourceCode.Add(PropertyIntfMethodSetText); - - sourceCode.Add(PropertyIntfMethodSet); - hasMembers := True; - end; - - dxmPropertyDeclaration: - begin - if writeOptional then - sourceCode.Add(PropertyInterfaceOptional); - - if itemProperty.IsReadOnly then - begin - if writeTextProp then - sourceCode.Add(PropertyInterfaceTextReadOnly); - - sourceCode.Add(PropertyInterfaceReadOnly); - end else - begin - if writeTextProp then - sourceCode.Add(PropertyInterfaceText); - - sourceCode.Add(PropertyInterface); - end; - - hasMembers := True; - end; - end; - end; - dxsImplementation: - begin - { Implementation } - case member of - dxmPropertyGet: - begin - if writeOptional then - sourceCode.Add(PropertyImplMethodGetOptional); - - if writeTextProp then - sourceCode.Add(PropertyImplMethodGetText); - - sourceCode.Add('function TXML%:s.Get%:s: %:s;'); - - case itemProperty.PropertyType of - ptSimple: - sourceCode.Add(XMLToNativeDataType('Result', - 'ChildNodes[''%:s''].NodeValue', - TXMLDataBindingSimpleProperty(itemProperty).DataType)); - - ptItem: - begin - if Assigned(propertyItem) then - begin - case propertyItem.ItemType of - itInterface, - itCollection: - begin - sourceCode.Add('begin'); - sourceCode.Add(' Result := (ChildNodes[''%:s''] as IXML%:s);'); - sourceCode.Add('end;'); - end; - - itEnumeration: - begin - sourceCode.Add('var'); - sourceCode.Add(' nodeValue: WideString;'); - sourceCode.Add(' enumValue: %:s;'); - sourceCode.AddLn; - sourceCode.Add('begin'); - sourceCode.Add(' Result := %:s(-1);'); - sourceCode.Add(' nodeValue := Get%:sText;'); - sourceCode.Add(' for enumValue := Low(%:s) to High(%:s) do'); - sourceCode.Add(' if %:sValues[enumValue] = nodeValue then'); - sourceCode.Add(' begin'); - sourceCode.Add(' Result := enumValue;'); - sourceCode.Add(' break;'); - sourceCode.Add(' end;'); - sourceCode.Add('end;'); - end; - end; - end; - end; - end; - - sourceCode.AddLn; - end; - dxmPropertySet: - if not itemProperty.IsReadOnly then - begin - if writeTextProp then - sourceCode.Add(PropertyImplMethodSetText); - - sourceCode.Add('procedure TXML%:s.Set%:s(const Value: %:s);'); - value := 'ChildNodes[''%:s''].NodeValue'; - - if Assigned(propertyItem) and (propertyItem.ItemType = itEnumeration) then - begin - sourceCode.Add('begin'); - sourceCode.Add(' ' + value + ' := %:sValues[Value]'); - sourceCode.Add('end;'); - sourceCode.AddLn; - end else - begin - if itemProperty.PropertyType <> ptSimple then - raise Exception.Create('Setter must be a simple type'); - - sourceCode.Add(NativeDataTypeToXML(value, 'Value', - TXMLDataBindingSimpleProperty(itemProperty).DataType)); - end; - end; - end; - end; - end; - - propertyItemName := ''; - if Assigned(propertyItem) then - propertyItemName := propertyItem.TranslatedName; - - AStream.Write(sourceCode.Format(['Name', AItem.TranslatedName, - 'PropertySourceName', itemProperty.Name, - 'PropertyName', itemProperty.TranslatedName, - 'PropertyItemName', propertyItemName, - 'DataType', dataTypeName])); - finally - FreeAndNil(sourceCode); - end; + firstMember := False; + hasMembers := True; end; end; end; - - if ASection = dxsClass then - WriteAfterConstruction(); end; -procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollection(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection); -begin - if not Assigned(AItem.CollectionItem) then - Exit; - - case ASection of - dxsForward: - AStream.WriteLnNamedFmt(InterfaceItemForward, - ['Name', - AItem.TranslatedName]); - dxsInterface: - begin - AStream.WriteLnNamedFmt(InterfaceItemInterface, - ['Name', AItem.TranslatedName, - 'ParentName', CollectionInterface]); - AStream.WriteLn(' ' + CreateNewGUID()); - - WriteSchemaCollectionProperties(AStream, AItem, ASection); - - AStream.WriteLn(' end;'); - AStream.WriteLn(); - end; - dxsClass: - begin - AStream.WriteLnNamedFmt(InterfaceItemClass, - ['Name', AItem.TranslatedName, - 'ParentName', 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); +function TDelphiXMLDataBindingGenerator.WriteSchemaInterfaceCollectionProperties(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection): Boolean; var - dataIntfName: string; - dataTypeName: string; - dataClassName: string; + dataIntfName: String; + dataTypeName: String; + dataClassName: String; + collectionItem: TXMLDataBindingItem; sourceCode: TNamedFormatStringList; typeDef: IXMLTypeDef; begin - if ASection = dxsClass then - AStream.WriteLn(' protected'); + Result := False; + + if not AItem.IsCollection then + Exit; - // #ToDo1 (MvR) 17-3-2008: DataType for enumerations case AItem.CollectionItem.PropertyType of ptSimple: begin @@ -783,9 +918,20 @@ begin end; ptItem: begin - dataTypeName := PrefixInterface + AItem.CollectionItemTranslatedName; - dataClassName := PrefixClass + AItem.CollectionItemTranslatedName; - dataIntfName := dataTypeName; + collectionItem := TXMLDataBindingItemProperty(AItem.CollectionItem).Item; + + if collectionItem.ItemType = itEnumeration then + begin + // #ToDo1 (MvR) 17-3-2008: DataType and conversions for enumerations + dataTypeName := PrefixInterface + collectionItem.TranslatedName; + dataClassName := PrefixClass + collectionItem.TranslatedName; + dataIntfName := dataTypeName; + end else + begin + dataTypeName := PrefixInterface + collectionItem.TranslatedName; + dataClassName := PrefixClass + collectionItem.TranslatedName; + dataIntfName := dataTypeName; + end; end; end; @@ -811,37 +957,26 @@ begin end; end; end; + dxsImplementation: begin - sourceCode.Add('procedure TXML%:s.AfterConstruction;'); - sourceCode.Add('begin'); - sourceCode.Add(' RegisterChildNode(''%:s'', %:s);'); - sourceCode.AddLn; - sourceCode.Add(' ItemTag := ''%:s'';'); - sourceCode.Add(' ItemInterface := %:s;'); - sourceCode.AddLn; - sourceCode.Add(' inherited;'); - sourceCode.Add('end;'); - sourceCode.AddLn; - - case AItem.CollectionItem.PropertyType of ptSimple: begin typeDef := TXMLDataBindingSimpleProperty(AItem.CollectionItem).DataType; - // #ToDo1 (MvR) 19-3-2008: .Text for strings ? + // #ToDo3 (MvR) 19-3-2008: use Text for strings ? sourceCode.Add('function TXML%:s.Get_%:s(Index: Integer): %:s;'); - sourceCode.Add(XMLToNativeDataType('Result', 'List[Index].NodeValue', typeDef)); + sourceCode.Add(XMLToNativeDataType('Result', 'List[Index].NodeValue', typeDef, dntCustom)); sourceCode.AddLn; sourceCode.Add('function TXML%:s.Add(%:s: %:s): %:s;'); - sourceCode.Add(NativeDataTypeToXML('Result.NodeValue', '%:s', typeDef, + sourceCode.Add(NativeDataTypeToXML('Result.NodeValue', '%:s', typeDef, dntCustom, ' Result := AddItem(-1);')); sourceCode.AddLn; sourceCode.Add('function TXML%:s.Insert(Index: Integer; %:s: %:s): %:s;'); - sourceCode.Add(NativeDataTypeToXML('Result.NodeValue', '%:s', typeDef, + sourceCode.Add(NativeDataTypeToXML('Result.NodeValue', '%:s', typeDef, dntCustom, ' Result := AddItem(Index);')); sourceCode.AddLn; end; @@ -871,26 +1006,255 @@ begin end; end; - case ASection of - dxsInterface: - begin - sourceCode.AddLn; - sourceCode.Add(' property %:s[Index: Integer]: %:s read Get_%:s; default;'); - end; + if ASection = dxsInterface then + begin + sourceCode.AddLn; + sourceCode.Add(' property %:s[Index: Integer]: %:s read Get_%:s; default;'); + end; + Result := (sourceCode.Count > 0); + + if Result then + AStream.Write(sourceCode.Format(['Name', AItem.TranslatedName, + 'ItemName', AItem.CollectionItem.TranslatedName, + 'ItemSourceName', AItem.CollectionItem.Name, + 'DataType', dataTypeName, + 'DataClass', dataClassName, + 'DataInterface', dataIntfName])); + finally + FreeAndNil(sourceCode); + end; +end; + + +function TDelphiXMLDataBindingGenerator.WriteSchemaInterfaceProperty(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; AProperty: TXMLDataBindingProperty; ASection: TDelphiXMLSection; AMember: TDelphiXMLMember; ANewLine: Boolean): Boolean; + + procedure WriteNewLine; + begin + if ANewLine then + AStream.WriteLn; + end; + + +var + sourceCode: TNamedFormatStringList; + writeOptional: Boolean; + writeTextProp: Boolean; + propertyItem: TXMLDataBindingItem; + dataTypeName: String; + value: String; + propertyItemName: String; + fieldName: String; + +begin + Result := False; + + if AProperty = AItem.CollectionItem then + Exit; + + { If the property has a collection, it's Count property will be enough + to check if an item is present, no need to write a HasX method. } + // #ToDo3 (MvR) 14-4-2008: move first check to XMLDataBindingGenerator ? + writeOptional := not Assigned(AProperty.Collection) and + AProperty.IsOptional and + (AMember in [dxmPropertyGet, dxmPropertyDeclaration]); + + + dataTypeName := ''; + propertyItem := nil; + fieldName := ''; + + { Get data type } + writeTextProp := False; + + if Assigned(AProperty.Collection) then + begin + dataTypeName := PrefixInterface + AProperty.Collection.TranslatedName; + fieldName := PrefixField + AProperty.TranslatedName; + end else + begin + case AProperty.PropertyType of + ptSimple: + dataTypeName := TranslateDataType(TXMLDataBindingSimpleProperty(AProperty).DataType); + + ptItem: + begin + propertyItem := TXMLDataBindingItemProperty(AProperty).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; + end; + + + if Length(dataTypeName) = 0 then + Exit; + + + sourceCode := TNamedFormatStringList.Create(); + try + case ASection of + dxsInterface, dxsClass: begin - sourceCode.Add(' public'); - sourceCode.Add(' procedure AfterConstruction; override;'); + { Interface declaration } + case AMember of + dxmPropertyGet: + begin + WriteNewLine; + + if writeOptional then + sourceCode.Add(PropertyIntfMethodGetOptional); + + if writeTextProp then + sourceCode.Add(PropertyIntfMethodGetText); + + sourceCode.Add(PropertyIntfMethodGet); + end; + + dxmPropertySet: + if not AProperty.IsReadOnly then + begin + WriteNewLine; + + if writeTextProp then + sourceCode.Add(PropertyIntfMethodSetText); + + sourceCode.Add(PropertyIntfMethodSet); + end; + + dxmPropertyDeclaration: + if ASection = dxsInterface then + begin + WriteNewLine; + + if writeOptional then + sourceCode.Add(PropertyInterfaceOptional); + + if AProperty.IsReadOnly then + begin + if writeTextProp then + sourceCode.Add(PropertyInterfaceTextReadOnly); + + sourceCode.Add(PropertyInterfaceReadOnly); + end else + begin + if writeTextProp then + sourceCode.Add(PropertyInterfaceText); + + sourceCode.Add(PropertyInterface); + end; + end; + end; + end; + dxsImplementation: + begin + { Implementation } + case AMember of + dxmPropertyGet: + begin + WriteNewLine; + + if writeOptional then + sourceCode.Add(PropertyImplMethodGetOptional); + + if writeTextProp then + sourceCode.Add(PropertyImplMethodGetText); + + sourceCode.Add('function TXML%:s.Get%:s: %:s;'); + + case AProperty.PropertyType of + ptSimple: + sourceCode.Add(XMLToNativeDataType('Result', + '%:s', + TXMLDataBindingSimpleProperty(AProperty).DataType, + GetDelphiNodeType(AProperty))); + + ptItem: + begin + if Assigned(AProperty.Collection) then + begin + sourceCode.Add('begin'); + sourceCode.Add(' Result := %:s;'); + sourceCode.Add('end;'); + end else + begin + if Assigned(propertyItem) then + begin + case propertyItem.ItemType of + itInterface: + begin + sourceCode.Add('begin'); + sourceCode.Add(' Result := (ChildNodes[''%:s''] as IXML%:s);'); + sourceCode.Add('end;'); + end; + + itEnumeration: + begin + sourceCode.Add('begin'); + sourceCode.Add(' Result := StringTo%:s(Get%:sText);'); + sourceCode.Add('end;'); + end; + end; + end; + end; + end; + end; + + sourceCode.AddLn; + end; + dxmPropertySet: + if not AProperty.IsReadOnly then + begin + WriteNewLine; + + if writeTextProp then + sourceCode.Add(PropertyImplMethodSetText); + + sourceCode.Add('procedure TXML%:s.Set%:s(const Value: %:s);'); + value := '%:s'; + + if Assigned(propertyItem) and (propertyItem.ItemType = itEnumeration) then + begin + sourceCode.Add(NativeDataTypeToXML(value, '%:sValues[Value]', nil, + GetDelphiNodeType(AProperty))); + end else + begin + if AProperty.PropertyType <> ptSimple then + raise Exception.Create('Setter must be a simple type'); + + sourceCode.Add(NativeDataTypeToXML(value, 'Value', + TXMLDataBindingSimpleProperty(AProperty).DataType, + GetDelphiNodeType(AProperty))); + end; + + sourceCode.AddLn; + end; + end; end; end; - AStream.Write(sourceCode.Format(['Name', AItem.TranslatedName, - 'ItemName', AItem.CollectionItemTranslatedName, - 'ItemSourceName', AItem.CollectionItem.Name, - 'DataType', dataTypeName, - 'DataClass', dataClassName, - 'DataInterface', dataIntfName])); + propertyItemName := ''; + if Assigned(propertyItem) then + propertyItemName := propertyItem.TranslatedName; + + Result := (sourceCode.Count > 0); + if Result then + AStream.Write(sourceCode.Format(['Name', AItem.TranslatedName, + 'PropertySourceName', AProperty.Name, + 'PropertyName', AProperty.TranslatedName, + 'PropertyItemName', propertyItemName, + 'DataType', dataTypeName, + 'FieldName', fieldName])); finally FreeAndNil(sourceCode); end; @@ -962,52 +1326,66 @@ begin end; -function TDelphiXMLDataBindingGenerator.DataTypeConversion(const ADestination, ASource: string; ADataType: IXMLTypeDef; AToNative: Boolean; const ALinesBefore: string): string; +function TDelphiXMLDataBindingGenerator.GetDelphiNodeType(AProperty: TXMLDataBindingProperty): TDelphiNodeType; +begin + if AProperty.IsAttribute then + Result := dntAttribute + else + Result := dntElement; +end; + + +function TDelphiXMLDataBindingGenerator.DataTypeConversion(const ADestination, ASource: String; ADataType: IXMLTypeDef; AAccessor: TDelphiAccessor; ANodeType: TDelphiNodeType; const ALinesBefore: String = ''): String; var typeMapping: TTypeMapping; + conversion: String; begin with TNamedFormatStringList.Create() do try - if not GetDataTypeMapping(ADataType, typeMapping) then + if not (Assigned(ADataType) and GetDataTypeMapping(ADataType, typeMapping)) then typeMapping.Conversion := tcNone; - if Length(TypeConversionVariables[typeMapping.Conversion]) > 0 then + (* + if Length(TypeConversionVariables[AAccessor, ANodeType, typeMapping.Conversion]) > 0 then begin Add('var'); - Add(TypeConversionVariables[typeMapping.Conversion]); + Add(TypeConversionVariables[AAccessor, ANodeType, typeMapping.Conversion]); end; + *) Add('begin'); if Length(ALinesBefore) > 0 then Add(ALinesBefore); - if AToNative then - Add(TypeConversionToNative[typeMapping.Conversion]) - else - Add(TypeConversionToXML[typeMapping.Conversion]); + conversion := TypeConversion[AAccessor, ANodeType, typeMapping.Conversion]; + if Length(conversion) = 0 then + conversion := TypeConversionNone[AAccessor, ANodeType]; + + + Add(conversion); Add('end;'); - - Result := Format(['Destination', ADestination, - 'Source', ASource]); + + Result := Trim(Format(['Destination', ADestination, + 'Source', ASource])); finally Free(); end; end; -function TDelphiXMLDataBindingGenerator.XMLToNativeDataType(const ADestination, ASource: string; ADataType: IXMLTypeDef; const ALinesBefore: string): string; +function TDelphiXMLDataBindingGenerator.XMLToNativeDataType(const ADestination, ASource: String; ADataType: IXMLTypeDef; ANodeType: TDelphiNodeType; const ALinesBefore: String): String; begin - Result := DataTypeConversion(ADestination, ASource, ADataType, True, ALinesBefore); + Result := DataTypeConversion(ADestination, ASource, ADataType, daGet, ANodeType, ALinesBefore); end; -function TDelphiXMLDataBindingGenerator.NativeDataTypeToXML(const ADestination, ASource: string; ADataType: IXMLTypeDef; const ALinesBefore: string): string; +function TDelphiXMLDataBindingGenerator.NativeDataTypeToXML(const ADestination, ASource: String; ADataType: IXMLTypeDef; ANodeType: TDelphiNodeType; const ALinesBefore: String): String; begin - Result := DataTypeConversion(ADestination, ASource, ADataType, False, ALinesBefore); + Result := DataTypeConversion(ADestination, ASource, ADataType, daSet, ANodeType, ALinesBefore); end; @@ -1041,6 +1419,26 @@ begin end; end; + +{ TXMLSchemaList } +constructor TXMLSchemaList.Create(); +begin + inherited Create(False); +end; + + +function TXMLSchemaList.GetItem(Index: Integer): TXMLDataBindingSchema; +begin + Result := TXMLDataBindingSchema(inherited GetItem(Index)); +end; + + +procedure TXMLSchemaList.SetItem(Index: Integer; const Value: TXMLDataBindingSchema); +begin + inherited SetItem(Index, Value); +end; + end. + diff --git a/Units/DelphiXMLDataBindingResources.pas b/Units/DelphiXMLDataBindingResources.pas index fb63b3f..71a90f3 100644 --- a/Units/DelphiXMLDataBindingResources.pas +++ b/Units/DelphiXMLDataBindingResources.pas @@ -4,6 +4,8 @@ interface type TDelphiXMLSection = (dxsForward, dxsInterface, dxsClass, dxsImplementation); TDelphiXMLMember = (dxmPropertyGet, dxmPropertySet, dxmPropertyDeclaration); + TDelphiAccessor = (daGet, daSet); + TDelphiNodeType = (dntElement, dntAttribute, dntCustom); const @@ -18,6 +20,7 @@ const UnitInterface = 'interface' + CrLf + 'uses' + CrLf + + '%:s' + ' Classes,' + CrLf + ' XMLDoc,' + CrLf + ' XMLIntf;' + CrLf + @@ -25,6 +28,9 @@ const 'type' + CrLf; UnitImplementation = 'implementation' + CrLf + + 'uses' + CrLf + + ' SysUtils;' + CrLf + + '' + CrLf + '' + CrLf; UnitFooter = '' + CrLf + @@ -110,6 +116,7 @@ const PrefixInterface = 'IXML'; PrefixClass = 'TXML'; + PrefixField = 'F'; InterfaceItemForward = ' IXML%:s = interface;'; @@ -169,6 +176,7 @@ const (SchemaName: 'int'; DelphiName: 'Integer'; Conversion: tcNone), (SchemaName: 'integer'; DelphiName: 'Integer'; Conversion: tcNone), (SchemaName: 'short'; DelphiName: 'Smallint'; Conversion: tcNone), + // #ToDo1 (MvR) 11-4-2008: differentiate date / time / dateTime (SchemaName: 'date'; DelphiName: 'TDateTime'; Conversion: tcDateTime), (SchemaName: 'time'; DelphiName: 'TDateTime'; Conversion: tcDateTime), (SchemaName: 'dateTime'; DelphiName: 'TDateTime'; Conversion: tcDateTime), @@ -180,33 +188,180 @@ const - TypeConversionNone = ' %:s := %:s;'; - - - TypeConversionVariables: array[TTypeConversion] of String = + TypeConversionNone: array[TDelphiAccessor, TDelphiNodeType] of String = ( - { tcNone } '', - { tcBoolean } '', - { tcFloat } '', - { tcDateTime } '' + { daGet } + ( + { dntElement } ' %:s := ChildNodes[''%:s''].NodeValue;', + { dntAttribute } ' %:s := AttributeNodes[''%:s''].NodeValue;', + { dntCustom } ' %:s := %:s;' + ), + { daSet } + ( + { dntElement } ' ChildNodes[''%:s''].NodeValue := %:s;', + { dntAttribute } ' SetAttribute(''%:s'', %:s);', + { dntCustom } ' %:s := %:s;' + ) ); - TypeConversionToNative: array[TTypeConversion] of String = + + TypeConversionHelpers: array[TTypeConversion] of String = ( - { tcNone } TypeConversionNone, - { tcBoolean } TypeConversionNone, - { tcFloat } TypeConversionNone, - { tcDateTime } TypeConversionNone + { tcNone } + '', + + { tcBoolean } + 'function BoolToXML(AValue: Boolean): WideString;' + CrLf + + 'begin' + CrLf + + ' Result := LowerCase(BoolToStr(AValue, True));' + CrLf + + 'end;' + CrLf + + '' + CrLf, + + { tcFloat } + 'function GetXMLFloatFormatSettings: TFormatSettings;' + CrLf + + 'begin' + CrLf + + ' Result.DecimalSeparator := ''.'';' + CrLf + + 'end;' + CrLf + + '' + CrLf + + 'function FloatToXML(AValue: Extended): WideString;' + CrLf + + 'begin' + CrLf + + ' Result := FloatToStr(AValue, GetXMLFloatFormatSettings);' + CrLf + + 'end;' + CrLf + + '' + CrLf + + 'function XMLToFloat(const AValue: String): Extended;' + CrLf + + 'begin' + CrLf + + ' Result := StrToFloat(AValue, GetXMLFloatFormatSettings);' + CrLf + + 'end;' + CrLf + + '' + CrLf, + + + { tcDate } + // #ToDo1 (MvR) 11-4-2008: handle time in XMLToDateTime + 'function DateToXML(AValue: TDateTime): WideString;' + CrLf + + 'begin' + CrLf + + ' Result := FormatDateTime(''yyyy"-"mm"-"dd'', AValue);' + CrLf + + 'end;' + CrLf + + '' + CrLf + + 'function XMLToDate(const ADate: String): TDateTime;' + CrLf + + 'begin' + CrLf + + ' try' + CrLf + + ' Result := EncodeDate(StrToInt(Copy(ADate, 1, 4)),' + CrLf + + ' StrToInt(Copy(ADate, 6, 2)),' + CrLf + + ' StrToInt(Copy(ADate, 9, 2)));' + CrLf + + ' except' + CrLf + + ' on E:EConvertError do' + CrLf + + ' Result := 0;' + CrLf + + ' end;' + CrLf + + 'end;' + CrLf + + '' + CrLf ); - TypeConversionToXML: array[TTypeConversion] of String = + + TypeConversion: array[TDelphiAccessor, TDelphiNodeType, TTypeConversion] of String = ( - { tcNone } TypeConversionNone, - { tcBoolean } ' %:s := LowerCase(BoolToStr(%:s, True));', - { tcFloat } TypeConversionNone, - { tcDateTime } TypeConversionNone + { daGet } + ( + { dntElement } + ( + { tcNone } '', + { tcBoolean } '', + { tcFloat } ' %:s := XMLToFloat(ChildNodes[''%:s''].NodeValue);', + { tcDateTime } ' %:s := XMLToDate(ChildNodes[''%:s''].NodeValue);' + ), + { dntAttribute } + ( + { tcNone } '', + { tcBoolean } '', + { tcFloat } ' %:s := XMLToFloat(AttributeNodes[''%:s''].NodeValue);', + { tcDateTime } ' %:s := XMLToDate(AttributeNodes[''%:s''].NodeValue);' + ), + { dntCustom} + ( + { tcNone } '', + { tcBoolean } '', + { tcFloat } ' %:s := XMLToFloat(%:s);', + { tcDateTime } ' %:s := XMLToDate(%:s);' + ) + ), + { daSet } + ( + { dntElement } + ( + { tcNone } '', + { tcBoolean } ' ChildNodes[''%:s''].NodeValue := BoolToXML(%:s);', + { tcFloat } ' ChildNodes[''%:s''].NodeValue := FloatToXML(%:s);', + { tcDateTime } ' ChildNodes[''%:s''].NodeValue := DateToXML(%:s);' + ), + { dntAttribute } + ( + { tcNone } '', + { tcBoolean } ' SetAttribute(''%:s'', BoolToXML(%:s));', + { tcFloat } ' SetAttribute(''%:s'', FloatToXML(%:s));', + { tcDateTime } ' SetAttribute(''%:s'', DateToXML(%:s));' + ), + { dntCustom} + ( + { tcNone } '', + { tcBoolean } ' %:s := BoolToXML(%:s);', + { tcFloat } ' %:s := FloatToXML(%:s);', + { tcDateTime } ' %:s := DateToXML(%:s);' + ) + ) ); + (* + TypeConversionVariables: array[TDelphiAccessor, TDelphiNodeType, TTypeConversion] of String = + ( + { daGet } + ( + { dntElement } + ( + { tcNone } '', + { tcBoolean } '', + { tcFloat } '', + { tcDateTime } '' + ), + { dntAttribute } + ( + { tcNone } '', + { tcBoolean } '', + { tcFloat } '', + { tcDateTime } '' + ), + { dntCustom} + ( + { tcNone } '', + { tcBoolean } '', + { tcFloat } '', + { tcDateTime } '' + ) + ), + { daSet } + ( + { dntElement } + ( + { tcNone } '', + { tcBoolean } '', + { tcFloat } '', + { tcDateTime } '' + ), + { dntAttribute } + ( + { tcNone } '', + { tcBoolean } '', + { tcFloat } '', + { tcDateTime } '' + ), + { dntCustom} + ( + { tcNone } '', + { tcBoolean } '', + { tcFloat } '', + { tcDateTime } '' + ) + ) + ); + *) implementation end. diff --git a/Units/XMLDataBindingGenerator.pas b/Units/XMLDataBindingGenerator.pas index 5acac3c..f9d1f62 100644 --- a/Units/XMLDataBindingGenerator.pas +++ b/Units/XMLDataBindingGenerator.pas @@ -1,8 +1,5 @@ unit XMLDataBindingGenerator; -// #ToDo1 (MvR) 7-3-2008: check if List items can be collapsed if an item is -// already a list parent -// #ToDo1 (MvR) 19-3-2008: attributes interface uses Classes, @@ -11,20 +8,21 @@ uses type TXMLDataBindingSchema = class; + TXMLDataBindingGeneratorItem = class; TXMLDataBindingItem = class; TXMLDataBindingInterface = class; - TXMLDataBindingCollection = class; TXMLDataBindingEnumerationMember = class; TXMLDataBindingEnumeration = class; TXMLDataBindingProperty = class; + TXMLDataBindingUnresolvedItem = class; TXMLDataBindingOutputType = (otSingle, otMultiple); - TXMLDataBindingItemType = (itInterface, itCollection, itEnumeration, - itEnumerationMember, itProperty, itForward, - itComplexTypeElement); + TXMLDataBindingItemType = (itInterface, itEnumeration, itEnumerationMember, + itProperty, itUnresolved, itAlias); TXMLDataBindingInterfaceType = (ifElement, ifComplexType); TXMLDataBindingPropertyType = (ptSimple, ptItem); + TXMLDataBindingOccurance = (boMinOccurs, boMaxOccurs); TXMLDataBindingIterateItemsProc = procedure(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean) of object; @@ -38,39 +36,44 @@ type FSourceFileName: String; FSchemas: TObjectList; - FMustResolve: Boolean; function GetSchemaCount(): Integer; function GetSchemas(Index: Integer): TXMLDataBindingSchema; protected function LoadSchema(const AStream: TStream; const ASchemaName: String): TXMLDataBindingSchema; - function GetSchemaData(const ALocation: String): TStream; + function GetSchemaData(const ALocation: String; out ASourceFileName: 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 CheckElementOccurance(AElement: IXMLElementDef; AOccurance: TXMLDataBindingOccurance): Boolean; + function IsElementOptional(AElement: IXMLElementDef): Boolean; + function IsElementRepeating(AElement: IXMLElementDef): Boolean; + function IsChoice(AElement: IXMLElementDef): Boolean; + function ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem; procedure ProcessChildElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef; AInterface: TXMLDataBindingInterface); + procedure ProcessAttribute(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef; 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 ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); + procedure ResolveSchema(ASchema: TXMLDataBindingSchema); - procedure ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); + procedure ResolveAlias(ASchema: TXMLDataBindingSchema); + procedure ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingUnresolvedItem); procedure ResolveNameConflicts(); - procedure TranslateSchema(ASchema: TXMLDataBindingSchema); - procedure TranslateItem(AItem: TXMLDataBindingItem); + procedure PostProcessSchema(ASchema: TXMLDataBindingSchema); + procedure PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); function TranslateItemName(AItem: TXMLDataBindingItem): String; virtual; procedure GenerateDataBinding(); virtual; abstract; @@ -91,47 +94,67 @@ type end; - TXMLDataBindingSchema = class(TObject) + TXMLDataBindingGeneratorItem = class(TObject) + private + FOwner: TXMLDataBindingGenerator; + protected + procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); virtual; + + property Owner: TXMLDataBindingGenerator read FOwner; + public + constructor Create(AOwner: TXMLDataBindingGenerator); + end; + + + TXMLDataBindingSchema = class(TXMLDataBindingGeneratorItem) private FIncludes: TObjectList; FItems: TObjectList; FItemsGenerated: Boolean; FSchemaDef: IXMLSchemaDef; FSchemaName: String; + FSourceFileName: String; function GetItemCount(): Integer; function GetItems(Index: Integer): TXMLDataBindingItem; function GetIncludeCount(): Integer; function GetIncludes(Index: Integer): TXMLDataBindingSchema; protected + procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); override; + procedure AddInclude(ASchema: TXMLDataBindingSchema); procedure AddItem(AItem: TXMLDataBindingItem); + procedure InsertItem(AItem, AAfter: TXMLDataBindingItem); property ItemsGenerated: Boolean read FItemsGenerated write FItemsGenerated; public - constructor Create(); + constructor Create(AOwner: TXMLDataBindingGenerator); 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 SchemaDef: IXMLSchemaDef read FSchemaDef write FSchemaDef; + property SchemaName: String read FSchemaName write FSchemaName; + property SourceFileName: String read FSourceFileName write FSourceFileName; property ItemCount: Integer read GetItemCount; property Items[Index: Integer]: TXMLDataBindingItem read GetItems; end; - TXMLDataBindingItem = class(TObject) + TXMLDataBindingItem = class(TXMLDataBindingGeneratorItem) private + FCollectionItem: TXMLDataBindingProperty; FDocumentElement: Boolean; FName: String; + FSchema: TXMLDataBindingSchema; FSchemaItem: IXMLSchemaItem; FTranslatedName: String; function GetDocumentation(): String; function GetHasDocumentation(): Boolean; + function GetIsCollection: Boolean; protected function GetItemType(): TXMLDataBindingItemType; virtual; abstract; procedure SetName(const Value: String); @@ -139,7 +162,9 @@ type property SchemaItem: IXMLSchemaItem read FSchemaItem; public - constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String); + constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String); + + property Schema: TXMLDataBindingSchema read FSchema write FSchema; property DocumentElement: Boolean read FDocumentElement write FDocumentElement; property Documentation: String read GetDocumentation; @@ -147,6 +172,9 @@ type property ItemType: TXMLDataBindingItemType read GetItemType; property Name: String read FName; property TranslatedName: String read FTranslatedName; + + property CollectionItem: TXMLDataBindingProperty read FCollectionItem write FCollectionItem; + property IsCollection: Boolean read GetIsCollection; end; @@ -162,13 +190,15 @@ type protected function GetItemType(): TXMLDataBindingItemType; override; + procedure ReplaceItem(const AOldItem: TXMLDataBindingItem; const ANewItem: TXMLDataBindingItem); override; + procedure AddProperty(AProperty: TXMLDataBindingProperty); public - constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String); + constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String); destructor Destroy; override; - property BaseName: String read FBaseName write FBaseName; - property BaseItem: TXMLDataBindingInterface read FBaseItem write FBaseItem; + property BaseName: String read FBaseName write FBaseName; + property BaseItem: TXMLDataBindingInterface read FBaseItem write FBaseItem; property InterfaceType: TXMLDataBindingInterfaceType read FInterfaceType; @@ -177,30 +207,13 @@ type end; - TXMLDataBindingCollection = class(TXMLDataBindingItem) - private - FCollectionItem: TXMLDataBindingProperty; - - function GetActualCollectionItem(): TXMLDataBindingItem; - function GetCollectionItemName(): String; - function GetCollectionItemTranslatedName(): String; - procedure SetCollectionItem(const Value: TXMLDataBindingProperty); - protected - function GetItemType(): TXMLDataBindingItemType; override; - public - property CollectionItem: TXMLDataBindingProperty read FCollectionItem; - property CollectionItemName: String read GetCollectionItemName; - property CollectionItemTranslatedName: String read GetCollectionItemTranslatedName; - end; - - TXMLDataBindingEnumerationMember = class(TXMLDataBindingItem) private FEnumeration: TXMLDataBindingEnumeration; protected function GetItemType(): TXMLDataBindingItemType; override; public - constructor Create(AEnumeration: TXMLDataBindingEnumeration; const AName: String); + constructor Create(AOwner: TXMLDataBindingGenerator; AEnumeration: TXMLDataBindingEnumeration; const AName: String); property Enumeration: TXMLDataBindingEnumeration read FEnumeration; end; @@ -216,7 +229,7 @@ type protected function GetItemType(): TXMLDataBindingItemType; override; public - constructor Create(ASchemaItem: IXMLSchemaItem; ADataType: IXMLTypeDef; const AName: String); + constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; ADataType: IXMLTypeDef; const AName: String); destructor Destroy(); override; property DataType: IXMLTypeDef read FDataType; @@ -227,16 +240,23 @@ type TXMLDataBindingProperty = class(TXMLDataBindingItem) private - FIsOptional: Boolean; + FIsAttribute: Boolean; + FIsOptional: Boolean; + FIsRepeating: Boolean; + FCollection: TXMLDataBindingInterface; protected function GetIsReadOnly(): Boolean; virtual; abstract; function GetItemType(): TXMLDataBindingItemType; override; function GetPropertyType(): TXMLDataBindingPropertyType; virtual; abstract; public + property IsAttribute: Boolean read FIsAttribute write FIsAttribute; property IsOptional: Boolean read FIsOptional write FIsOptional; property IsReadOnly: Boolean read GetIsReadOnly; + property IsRepeating: Boolean read FIsRepeating write FIsRepeating; property PropertyType: TXMLDataBindingPropertyType read GetPropertyType; + + property Collection: TXMLDataBindingInterface read FCollection write FCollection; end; @@ -247,7 +267,7 @@ type function GetIsReadOnly(): Boolean; override; function GetPropertyType(): TXMLDataBindingPropertyType; override; public - constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String; ADataType: IXMLTypeDef); + constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; ADataType: IXMLTypeDef); property DataType: IXMLTypeDef read FDataType; end; @@ -256,37 +276,37 @@ type 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; + procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); override; + public + constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AItem: TXMLDataBindingItem); + + property Item: TXMLDataBindingItem read FItem; end; - TXMLDataBindingForwardItem = class(TXMLDataBindingItem) + TXMLDataBindingUnresolvedItem = class(TXMLDataBindingItem) private - FItem: TXMLDataBindingItem; FInterfaceType: TXMLDataBindingInterfaceType; protected function GetItemType(): TXMLDataBindingItemType; override; public - constructor Create(ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType); + constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType); property InterfaceType: TXMLDataBindingInterfaceType read FInterfaceType; - property Item: TXMLDataBindingItem read FItem write FItem; end; - TXMLDataBindingComplexTypeElementItem = class(TXMLDataBindingItem) + TXMLDataBindingAliasItem = class(TXMLDataBindingItem) private FItem: TXMLDataBindingItem; protected function GetItemType(): TXMLDataBindingItemType; override; + + procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); override; public property Item: TXMLDataBindingItem read FItem write FItem; end; @@ -305,6 +325,7 @@ uses const MaxOccursUnbounded = 'unbounded'; + UseOptional = 'optional'; CollectionPostfix = 'List'; @@ -318,29 +339,11 @@ begin end; -function GetActualItem(AItem: TXMLDataBindingItem): TXMLDataBindingItem; -begin - Result := AItem; - - while Assigned(Result) do - begin - case Result.ItemType of - itForward: - Result := TXMLDataBindingForwardItem(Result).Item; - - itComplexTypeElement: - Result := TXMLDataBindingComplexTypeElementItem(Result).Item; - else - break; - end; - end; -end; - { TXMLDataBindingGenerator } constructor TXMLDataBindingGenerator.Create(); begin - inherited; + inherited Create(); FIncludePaths := TStringList.Create(); FSchemas := TObjectList.Create(True); @@ -365,10 +368,13 @@ end; procedure TXMLDataBindingGenerator.Execute(const AStream: TStream; const ASchemaName: String); var schemaIndex: Integer; + schema: TXMLDataBindingSchema; begin FSchemas.Clear(); - LoadSchema(AStream, ASchemaName); + schema := LoadSchema(AStream, ASchemaName); + if Assigned(schema) then + schema.SourceFileName := SourceFileName; if SchemaCount > 0 then begin @@ -377,26 +383,23 @@ begin GenerateSchemaObjects(Schemas[schemaIndex], (schemaIndex = 0)); - { Process unresolved references - - some references can't be resolved the first time (especially - ComplexTypeElement references). Fix this workaround some time. } - for schemaIndex := 0 to Pred(SchemaCount) do + { Process unresolved references } + for schemaIndex := Pred(SchemaCount) downto 0 do ResolveSchema(Schemas[schemaIndex]); - for schemaIndex := 0 to Pred(SchemaCount) do - ResolveSchema(Schemas[schemaIndex]); + + { After all lookups have been done, unwrap alias items } + for schemaIndex := Pred(SchemaCount) downto 0 do + ResolveAlias(Schemas[schemaIndex]); - { Collapse collections } - - { Resolve naming conflicts } ResolveNameConflicts(); - { Perform output-specific translations } + { Perform final post-processing (translating names, generating collections) } for schemaIndex := 0 to Pred(SchemaCount) do - TranslateSchema(Schemas[schemaIndex]); + PostProcessSchema(Schemas[schemaIndex]); { Output } @@ -440,6 +443,7 @@ function TXMLDataBindingGenerator.LoadSchema(const AStream: TStream; const ASche refSchema: TXMLDataBindingSchema; refIndex: Integer; refStream: TStream; + sourceFileName: String; begin for refIndex := 0 to Pred(ADocRefs.Count) do @@ -450,11 +454,14 @@ function TXMLDataBindingGenerator.LoadSchema(const AStream: TStream; const ASche if not Assigned(refSchema) then begin - refStream := GetSchemaData(location); + refStream := GetSchemaData(location, sourceFileName); if Assigned(refStream) then try refSchema := LoadSchema(refStream, schemaName); + + if Assigned(refSchema) then + refSchema.SourceFileName := sourceFileName; finally FreeAndNil(refStream); end; @@ -475,7 +482,7 @@ begin schemaDoc.LoadFromStream(AStream); schemaDef := schemaDoc.SchemaDef; - Result := TXMLDataBindingSchema.Create(); + Result := TXMLDataBindingSchema.Create(Self); Result.SchemaDef := schemaDef; Result.SchemaName := ASchemaName; FSchemas.Add(Result); @@ -486,7 +493,7 @@ begin end; -function TXMLDataBindingGenerator.GetSchemaData(const ALocation: String): TStream; +function TXMLDataBindingGenerator.GetSchemaData(const ALocation: String; out ASourceFileName: String): TStream; var includeIndex: Integer; includePath: String; @@ -502,7 +509,8 @@ begin if FileExists(includePath + ALocation) then begin - Result := TFileStream.Create(includePath + ALocation, fmOpenRead or fmShareDenyNone); + ASourceFileName := includePath + ALocation; + Result := TFileStream.Create(ASourceFileName, fmOpenRead or fmShareDenyNone); break; end; end; @@ -579,7 +587,7 @@ begin for complexTypeIndex := 0 to Pred(schemaDef.ComplexTypes.Count) do begin complexType := schemaDef.ComplexTypes[complexTypeIndex]; - interfaceItem := TXMLDataBindingInterface.Create(complexType, complexType.Name); + interfaceItem := TXMLDataBindingInterface.Create(Self, complexType, complexType.Name); ASchema.AddItem(interfaceItem); for elementIndex := 0 to Pred(complexType.ElementDefs.Count) do @@ -588,12 +596,75 @@ begin end; +function TXMLDataBindingGenerator.CheckElementOccurance(AElement: IXMLElementDef; AOccurance: TXMLDataBindingOccurance): Boolean; + + function CheckParent(const ANode: IXMLNode): Boolean; + var + compositor: IXMLElementCompositor; + + begin + Result := False; + + if Supports(ANode, IXMLElementCompositor, compositor) then + begin + case AOccurance of + boMinOccurs: Result := (compositor.MinOccurs = 0); + boMaxOccurs: Result := (compositor.MaxOccurs = MaxOccursUnbounded) or + (compositor.MaxOccurs > 1); + end; + + if not Result then + Result := CheckParent(compositor.ParentNode); + end; + end; + + +begin + Result := False; + + case AOccurance of + boMinOccurs: Result := (AElement.MinOccurs = 0); + boMaxOccurs: Result := (AElement.MaxOccurs = MaxOccursUnbounded) or + (AElement.MaxOccurs > 1); + end; + + if not Result then + Result := CheckParent(AElement.ParentNode); +end; + + +function TXMLDataBindingGenerator.IsElementOptional(AElement: IXMLElementDef): Boolean; +begin + Result := CheckElementOccurance(AElement, boMinOccurs); +end; + + +function TXMLDataBindingGenerator.IsElementRepeating(AElement: IXMLElementDef): Boolean; +begin + Result := CheckElementOccurance(AElement, boMaxOccurs); +end; + + +function TXMLDataBindingGenerator.IsChoice(AElement: IXMLElementDef): Boolean; +var + compositor: IXMLElementCompositor; + +begin + Result := False; + + if Supports(AElement, IXMLElementCompositor, compositor) then + Result := (compositor.CompositorType = ctChoice) and + (compositor.ElementDefs.Count > 1); +end; + + function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem; var elementIndex: Integer; + attributeIndex: Integer; enumerationObject: TXMLDataBindingEnumeration; interfaceObject: TXMLDataBindingInterface; - complexTypeElement: TXMLDataBindingComplexTypeElementItem; + aliasItem: TXMLDataBindingAliasItem; begin Result := nil; @@ -606,7 +677,7 @@ begin if not Assigned(Result) then begin - Result := TXMLDataBindingForwardItem.Create(AElement, AElement.Ref.Name, ifElement); + Result := TXMLDataBindingUnresolvedItem.Create(Self, AElement, AElement.Ref.Name, ifElement); ASchema.AddItem(Result); end; end else @@ -619,7 +690,7 @@ begin if not Assigned(Result) then begin - Result := TXMLDataBindingForwardItem.Create(AElement, AElement.DataTypeName, ifComplexType); + Result := TXMLDataBindingUnresolvedItem.Create(Self, AElement, AElement.DataTypeName, ifComplexType); ASchema.AddItem(Result); end; @@ -627,9 +698,9 @@ begin begin { The element is global, but only references a complex type. Keep track to properly resolve references to the element. } - complexTypeElement := TXMLDataBindingComplexTypeElementItem.Create(AElement, AElement.Name); - complexTypeElement.Item := Result; - ASchema.AddItem(complexTypeElement); + aliasItem := TXMLDataBindingAliasItem.Create(Self, AElement, AElement.Name); + aliasItem.Item := Result; + ASchema.AddItem(aliasItem); end; end; @@ -638,13 +709,13 @@ begin if AElement.DataType.Enumerations.Count > 0 then begin { Enumeration } - enumerationObject := TXMLDataBindingEnumeration.Create(AElement, AElement.DataType, AElement.Name); + enumerationObject := TXMLDataBindingEnumeration.Create(Self, 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); + interfaceObject := TXMLDataBindingInterface.Create(Self, AElement, AElement.Name); if Assigned(AElement.DataType.BaseType) then interfaceObject.BaseName := AElement.DataType.BaseTypeName; @@ -652,10 +723,14 @@ begin Result := interfaceObject; end; - if Assigned(interfaceObject) then + begin for elementIndex := 0 to Pred(AElement.ChildElements.Count) do ProcessChildElement(ASchema, AElement.ChildElements[elementIndex], interfaceObject); + + for attributeIndex := 0 to Pred(AElement.AttributeDefs.Count) do + ProcessAttribute(ASchema, AElement.AttributeDefs[attributeIndex], interfaceObject); + end; end; end; end; @@ -663,68 +738,49 @@ 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, AElement.Name + CollectionPostfix); - ASchema.AddItem(collectionObject); - end; - end; - end; - - - propertyType := ProcessElement(ASchema, AElement); - - if Assigned(collectionObject) then - begin - { Create intermediate object for collections } - if Assigned(propertyType) then - propertyItem := TXMLDataBindingItemProperty.Create(AElement, - propertyType.Name, - propertyType) - else - propertyItem := TXMLDataBindingSimpleProperty.Create(AElement, - AElement.Name, - AElement.DataType); - - - collectionObject.SetCollectionItem(propertyItem); - propertyType := collectionObject; - end; - + propertyType := ProcessElement(ASchema, AElement); if Assigned(AInterface) then begin if Assigned(propertyType) then - propertyItem := TXMLDataBindingItemProperty.Create(AElement, + propertyItem := TXMLDataBindingItemProperty.Create(Self, AElement, AElement.Name, propertyType) else - propertyItem := TXMLDataBindingSimpleProperty.Create(AElement, + propertyItem := TXMLDataBindingSimpleProperty.Create(Self, AElement, AElement.Name, AElement.DataType); - propertyItem.IsOptional := (AElement.MinOccurs = 0); + propertyItem.IsOptional := IsElementOptional(AElement) or + IsChoice(AElement); + propertyItem.IsRepeating := IsElementRepeating(AElement); + AInterface.AddProperty(propertyItem); end; end; +procedure TXMLDataBindingGenerator.ProcessAttribute(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef; AInterface: TXMLDataBindingInterface); +var + propertyItem: TXMLDataBindingProperty; + +begin + // #ToDo2 (MvR) 10-4-2008: complex attributes (enumerations) + propertyItem := TXMLDataBindingSimpleProperty.Create(Self, AAttribute, + AAttribute.Name, + AAttribute.DataType); + + propertyItem.IsOptional := (AAttribute.Use = UseOptional); + propertyItem.IsAttribute := True; + + AInterface.AddProperty(propertyItem); +end; + + function TXMLDataBindingGenerator.IterateSchemaItems(ASchema: TXMLDataBindingSchema; AIterateProc: TXMLDataBindingIterateItemsProc; AData: Pointer): TXMLDataBindingItem; var abort: Boolean; @@ -784,7 +840,7 @@ begin itInterface: AAbort := (TXMLDataBindingInterface(AItem).InterfaceType = findInfo^.InterfaceType); - itComplexTypeElement: + itAlias: AAbort := (findInfo^.InterfaceType = ifElement); end; end; @@ -798,7 +854,7 @@ var begin findInfo.InterfaceType := AType; findInfo.Name := AName; - Result := TXMLDataBindingInterface(GetActualItem(IterateSchemaItems(ASchema, FindInterfaceProc, @findInfo))); + Result := TXMLDataBindingInterface(IterateSchemaItems(ASchema, FindInterfaceProc, @findInfo)); end; @@ -815,27 +871,16 @@ begin end; -procedure TXMLDataBindingGenerator.FindCollectionProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean); +procedure TXMLDataBindingGenerator.ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); var - collection: TXMLDataBindingCollection; + schemaIndex: Integer; begin - if AItem.ItemType = itCollection then - begin - collection := TXMLDataBindingCollection(AItem); - AAbort := Assigned(collection.CollectionItem) and - (collection.CollectionItem.Name = PChar(AData)); - end; + for schemaIndex := Pred(SchemaCount) downto 0 do + Schemas[schemaIndex].ReplaceItem(AOldItem, ANewItem); 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; @@ -843,7 +888,7 @@ var interfaceItem: TXMLDataBindingInterface; begin - for itemIndex := 0 to Pred(ASchema.ItemCount) do + for itemIndex := Pred(ASchema.ItemCount) downto 0 do begin item := ASchema.Items[itemIndex]; @@ -858,35 +903,50 @@ begin interfaceItem.BaseItem := FindInterface(ASchema, interfaceItem.BaseName, ifComplexType); end; - itForward: - ResolveItem(ASchema, item); + itUnresolved: + ResolveItem(ASchema, TXMLDataBindingUnresolvedItem(item)); end; end; end; -procedure TXMLDataBindingGenerator.ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); +procedure TXMLDataBindingGenerator.ResolveAlias(ASchema: TXMLDataBindingSchema); +var + itemIndex: Integer; + item: TXMLDataBindingItem; + aliasItem: TXMLDataBindingAliasItem; + +begin + for itemIndex := Pred(ASchema.ItemCount) downto 0 do + begin + item := ASchema.Items[itemIndex]; + + if item.ItemType = itAlias then + begin + aliasItem := TXMLDataBindingAliasItem(item); + if Assigned(aliasItem.Item) then + ReplaceItem(aliasItem, aliasItem.Item); + end; + end; +end; + + +procedure TXMLDataBindingGenerator.ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingUnresolvedItem); var - forwardItem: TXMLDataBindingForwardItem; referenceItem: TXMLDataBindingItem; begin - if (not Assigned(AItem)) or (AItem.ItemType <> itForward) then + if not Assigned(AItem) then Exit; - { Resolve forwarded item } - forwardItem := TXMLDataBindingForwardItem(AItem); - if not Assigned(forwardItem.Item) then - begin - referenceItem := FindInterface(ASchema, AItem.Name, forwardItem.InterfaceType); + referenceItem := FindInterface(ASchema, AItem.Name, AItem.InterfaceType); - if (not Assigned(referenceItem)) and - (forwardItem.InterfaceType = ifElement) then - referenceItem := FindEnumeration(ASchema, AItem.Name); + if (not Assigned(referenceItem)) and + (AItem.InterfaceType = ifElement) then + referenceItem := FindEnumeration(ASchema, AItem.Name); - if Assigned(referenceItem) then - forwardItem.Item := referenceItem; - end; + if Assigned(referenceItem) then + ReplaceItem(AItem, referenceItem); end; @@ -901,12 +961,8 @@ var 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); @@ -973,7 +1029,7 @@ begin begin item := schema.Items[itemIndex]; - if item.ItemType in [itInterface, itCollection, itEnumeration] then + if item.ItemType in [itInterface, itEnumeration] then AddItem(item); end; end; @@ -1022,40 +1078,97 @@ begin end; -procedure TXMLDataBindingGenerator.TranslateSchema(ASchema: TXMLDataBindingSchema); +procedure TXMLDataBindingGenerator.PostProcessSchema(ASchema: TXMLDataBindingSchema); var itemIndex: Integer; begin - for itemIndex := 0 to Pred(ASchema.ItemCount) do - TranslateItem(ASchema.Items[itemIndex]); + for itemIndex := Pred(ASchema.ItemCount) downto 0 do + PostProcessItem(ASchema, ASchema.Items[itemIndex]); end; -procedure TXMLDataBindingGenerator.TranslateItem(AItem: TXMLDataBindingItem); +procedure TXMLDataBindingGenerator.PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); var - interfaceItem: TXMLDataBindingInterface; - propertyIndex: Integer; - enumerationItem: TXMLDataBindingEnumeration; - memberIndex: Integer; + collectionItem: TXMLDataBindingInterface; + collectionName: string; + enumerationItem: TXMLDataBindingEnumeration; + interfaceItem: TXMLDataBindingInterface; + memberIndex: Integer; + propertyIndex: Integer; + propertyItem: TXMLDataBindingProperty; + repeatingItems: TObjectList; begin + { Translate name } AItem.SetTranslatedName(TranslateItemName(AItem)); + + { Extract collections } + if AItem.ItemType = itInterface then + begin + interfaceItem := TXMLDataBindingInterface(AItem); + interfaceItem.CollectionItem := nil; + + repeatingItems := TObjectList.Create(False); + try + for propertyIndex := 0 to Pred(interfaceItem.PropertyCount) do + if interfaceItem.Properties[propertyIndex].IsRepeating then + repeatingItems.Add(interfaceItem.Properties[propertyIndex]); + + if repeatingItems.Count > 0 then + begin + if repeatingItems.Count = 1 then + begin + { Single repeating child, the item itself is a collection parent } + interfaceItem.CollectionItem := TXMLDataBindingProperty(repeatingItems[0]); + end else + begin + { Multiple repeating children, create intermediate collections for each } + for propertyIndex := 0 to Pred(repeatingItems.Count) do + begin + propertyItem := TXMLDataBindingProperty(repeatingItems[propertyIndex]); + + // #ToDo1 (MvR) 7-4-2008: check if an item with the "List" postfix + // exists in the schema, as it could cause + // conflicts. + + // #ToDo1 (MvR) 7-4-2008: check if the interfaceItem has a BaseItem, + // can't be combined with being a collection + case propertyItem.PropertyType of + ptSimple: collectionName := propertyItem.TranslatedName + CollectionPostfix; + ptItem: collectionName := propertyItem.TranslatedName + CollectionPostfix; + end; + + collectionItem := TXMLDataBindingInterface.Create(Self, propertyItem.SchemaItem, collectionName); + collectionItem.CollectionItem := propertyItem; + ASchema.InsertItem(collectionItem, interfaceItem); + + propertyItem.Collection := collectionItem; + end; + end; + end; + finally + FreeAndNil(repeatingItems); + end; + end; + + + { Process members } case AItem.ItemType of itInterface: begin interfaceItem := TXMLDataBindingInterface(AItem); for propertyIndex := 0 to Pred(interfaceItem.PropertyCount) do - TranslateItem(interfaceItem.Properties[propertyIndex]); + PostProcessItem(ASchema, interfaceItem.Properties[propertyIndex]); end; itEnumeration: begin enumerationItem := TXMLDataBindingEnumeration(AItem); for memberIndex := 0 to Pred(enumerationItem.MemberCount) do - TranslateItem(enumerationItem.Members[memberIndex]); + PostProcessItem(ASchema, enumerationItem.Members[memberIndex]); end; end; end; @@ -1079,10 +1192,24 @@ begin end; -{ TXMLDataBindingSchema } -constructor TXMLDataBindingSchema.Create(); +{ TXMLDataBindingGeneratorItem } +constructor TXMLDataBindingGeneratorItem.Create(AOwner: TXMLDataBindingGenerator); begin - inherited; + inherited Create(); + + FOwner := AOwner; +end; + + +procedure TXMLDataBindingGeneratorItem.ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); +begin +end; + + +{ TXMLDataBindingSchema } +constructor TXMLDataBindingSchema.Create(AOwner: TXMLDataBindingGenerator); +begin + inherited Create(AOwner); FIncludes := TObjectList.Create(False); FItems := TObjectList.Create(True); @@ -1098,6 +1225,21 @@ begin end; +procedure TXMLDataBindingSchema.ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); +var + itemIndex: Integer; + +begin + inherited; + + for itemIndex := Pred(ItemCount) downto 0 do + if Items[itemIndex] = AOldItem then + FItems.Extract(AOldItem) + else + Items[itemIndex].ReplaceItem(AOldItem, ANewItem); +end; + + procedure TXMLDataBindingSchema.AddInclude(ASchema: TXMLDataBindingSchema); begin if FIncludes.IndexOf(ASchema) = -1 then @@ -1108,7 +1250,28 @@ end; procedure TXMLDataBindingSchema.AddItem(AItem: TXMLDataBindingItem); begin if FItems.IndexOf(AItem) = -1 then + begin FItems.Add(AItem); + AItem.Schema := Self; + end; +end; + + +procedure TXMLDataBindingSchema.InsertItem(AItem, AAfter: TXMLDataBindingItem); +var + itemIndex: Integer; + +begin + if FItems.IndexOf(AItem) = -1 then + begin + itemIndex := FItems.IndexOf(AAfter); + if itemIndex > -1 then + FItems.Insert(Succ(itemIndex), AItem) + else + FItems.Add(AItem); + + AItem.Schema := Self; + end; end; @@ -1137,9 +1300,9 @@ end; { TXMLDataBindingItem } -constructor TXMLDataBindingItem.Create(ASchemaItem: IXMLSchemaItem; const AName: String); +constructor TXMLDataBindingItem.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String); begin - inherited Create(); + inherited Create(AOwner); FName := AName; FSchemaItem := ASchemaItem; @@ -1163,12 +1326,19 @@ begin end; -function TXMLDataBindingItem.GetHasDocumentation: Boolean; +function TXMLDataBindingItem.GetHasDocumentation(): Boolean; begin Result := Assigned(SchemaItem) and (SchemaItem.Documentation.Count > 0); end; + +function TXMLDataBindingItem.GetIsCollection(): Boolean; +begin + Result := Assigned(FCollectionItem); +end; + + procedure TXMLDataBindingItem.SetName(const Value: String); begin FName := Value; @@ -1182,9 +1352,9 @@ end; { TXMLDataBindingInterface } -constructor TXMLDataBindingInterface.Create(ASchemaItem: IXMLSchemaItem; const AName: String); +constructor TXMLDataBindingInterface.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String); begin - inherited Create(ASchemaItem, AName); + inherited Create(AOwner, ASchemaItem, AName); FProperties := TObjectList.Create(True); FInterfaceType := GetInterfaceType(SchemaItem); @@ -1199,6 +1369,18 @@ begin end; +procedure TXMLDataBindingInterface.ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); +var + propertyIndex: Integer; + +begin + inherited; + + for propertyIndex := Pred(PropertyCount) downto 0 do + Properties[propertyIndex].ReplaceItem(AOldItem, ANewItem); +end; + + procedure TXMLDataBindingInterface.AddProperty(AProperty: TXMLDataBindingProperty); begin FProperties.Add(AProperty); @@ -1223,60 +1405,10 @@ begin end; -{ TXMLDataBindingCollection } -function TXMLDataBindingCollection.GetItemType(): TXMLDataBindingItemType; -begin - Result := itCollection; -end; - - -function TXMLDataBindingCollection.GetActualCollectionItem(): TXMLDataBindingItem; -begin - Result := nil; - - if Assigned(CollectionItem) then - begin - case CollectionItem.PropertyType of - ptSimple: Result := CollectionItem; - ptItem: Result := TXMLDataBindingItemProperty(CollectionItem).Item; - end; - end; -end; - -function TXMLDataBindingCollection.GetCollectionItemName(): String; -var - item: TXMLDataBindingItem; - -begin - Result := ''; - item := GetActualCollectionItem(); - if Assigned(item) then - Result := item.Name; -end; - - -function TXMLDataBindingCollection.GetCollectionItemTranslatedName(): String; -var - item: TXMLDataBindingItem; - -begin - Result := ''; - item := GetActualCollectionItem(); - if Assigned(item) then - Result := item.Name; -end; - - -procedure TXMLDataBindingCollection.SetCollectionItem(const Value: TXMLDataBindingProperty); -begin - FCollectionItem := Value; -end; - - { TXMLDataBindingEnumerationMember } -constructor TXMLDataBindingEnumerationMember.Create(AEnumeration: TXMLDataBindingEnumeration; const AName: String); +constructor TXMLDataBindingEnumerationMember.Create(AOwner: TXMLDataBindingGenerator; AEnumeration: TXMLDataBindingEnumeration; const AName: String); begin - inherited Create(nil, AName); + inherited Create(AOwner, nil, AName); FEnumeration := AEnumeration; end; @@ -1289,18 +1421,18 @@ end; { TXMLDataBindingEnumeration } -constructor TXMLDataBindingEnumeration.Create(ASchemaItem: IXMLSchemaItem; ADataType: IXMLTypeDef; const AName: String); +constructor TXMLDataBindingEnumeration.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; ADataType: IXMLTypeDef; const AName: String); var memberIndex: Integer; begin - inherited Create(ASchemaItem, AName); + inherited Create(AOwner, 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)); + FMembers.Add(TXMLDataBindingEnumerationMember.Create(Owner, Self, ADataType.Enumerations.Items[memberIndex].Value)); end; @@ -1338,9 +1470,9 @@ end; { TXMLDataBindingSimpleProperty } -constructor TXMLDataBindingSimpleProperty.Create(ASchemaItem: IXMLSchemaItem; const AName: String; ADataType: IXMLTypeDef); +constructor TXMLDataBindingSimpleProperty.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; ADataType: IXMLTypeDef); begin - inherited Create(ASchemaItem, AName); + inherited Create(AOwner, ASchemaItem, AName); FDataType := ADataType; end; @@ -1359,14 +1491,23 @@ end; { TXMLDataBindingItemProperty } -constructor TXMLDataBindingItemProperty.Create(ASchemaItem: IXMLSchemaItem; const AName: String; AItem: TXMLDataBindingItem); +constructor TXMLDataBindingItemProperty.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AItem: TXMLDataBindingItem); begin - inherited Create(ASchemaItem, AName); + inherited Create(AOwner, ASchemaItem, AName); FItem := AItem; end; +procedure TXMLDataBindingItemProperty.ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); +begin + inherited; + + if FItem = AOldItem then + FItem := ANewItem; +end; + + function TXMLDataBindingItemProperty.GetIsReadOnly(): Boolean; begin Result := Assigned(Item) and (Item.ItemType <> itEnumeration); @@ -1379,31 +1520,34 @@ begin end; -function TXMLDataBindingItemProperty.GetItem(): TXMLDataBindingItem; +{ TXMLDataBindingUnresolvedItem } +constructor TXMLDataBindingUnresolvedItem.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType); begin - Result := GetActualItem(FItem); -end; - - -{ TXMLDataBindingForwardItem } -constructor TXMLDataBindingForwardItem.Create(ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType); -begin - inherited Create(ASchemaItem, AName); + inherited Create(AOwner, ASchemaItem, AName); FInterfaceType := AInterfaceType; end; -function TXMLDataBindingForwardItem.GetItemType(): TXMLDataBindingItemType; +function TXMLDataBindingUnresolvedItem.GetItemType(): TXMLDataBindingItemType; begin - Result := itForward; + Result := itUnresolved; end; -{ TXMLDataBindingComplexTypeElementItem } -function TXMLDataBindingComplexTypeElementItem.GetItemType(): TXMLDataBindingItemType; +{ TXMLDataBindingAliasItem } +procedure TXMLDataBindingAliasItem.ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); begin - Result := itComplexTypeElement; + inherited; + + if FItem = AOldItem then + FItem := ANewItem; +end; + + +function TXMLDataBindingAliasItem.GetItemType(): TXMLDataBindingItemType; +begin + Result := itAlias; end; end. diff --git a/X2XMLDataBindingCmdLine.cfg b/X2XMLDataBindingCmdLine.cfg index 8a733fd..06206f2 100644 --- a/X2XMLDataBindingCmdLine.cfg +++ b/X2XMLDataBindingCmdLine.cfg @@ -32,9 +32,13 @@ -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" +-N"Lib" +-LE"c:\program files\borland\delphi7\Projects\Bpl" +-LN"c:\program files\borland\delphi7\Projects\Bpl" +-U"P:\xtx\xtx\xsd" +-O"P:\xtx\xtx\xsd" +-I"P:\xtx\xtx\xsd" +-R"P:\xtx\xtx\xsd" -w-UNSAFE_TYPE -w-UNSAFE_CODE -w-UNSAFE_CAST diff --git a/X2XMLDataBindingCmdLine.dof b/X2XMLDataBindingCmdLine.dof index 3468bb5..95cee4e 100644 --- a/X2XMLDataBindingCmdLine.dof +++ b/X2XMLDataBindingCmdLine.dof @@ -94,13 +94,13 @@ OutputDir= UnitOutputDir=Lib PackageDLLOutputDir= PackageDCPOutputDir= -SearchPath= +SearchPath=P:\xtx\xtx\xsd 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" +RunParams="P:\xtx\xtx\xsd\Offerte.xsd" "P:\xtx\xtx\xsd\" HostApplication= Launcher= UseLauncher=0 @@ -135,22 +135,23 @@ 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\hlSearchPath] -Count=2 -Item0=..\.. -Item1=F:\Development\VDarts\Packages +Count=3 +Item0=P:\xtx\xtx\xsd +Item1=..\.. +Item2=F:\Development\VDarts\Packages [HistoryLists\hlUnitOutputDirectory] -Count=5 -Item0=P:\Algemeen\lib -Item1=..\..\Lib\D7 -Item2=..\..\Dcu -Item3=..\..\..\Dcu -Item4=Dcu +Count=6 +Item0=Lib +Item1=P:\Algemeen\lib +Item2=..\..\Lib\D7 +Item3=..\..\Dcu +Item4=..\..\..\Dcu +Item5=Dcu [HistoryLists\hlBPLOutput] Count=3 Item0=..\..\Lib\D7 diff --git a/X2XMLDataBindingCmdLine.dpr b/X2XMLDataBindingCmdLine.dpr index 7cbf30b..1489b81 100644 --- a/X2XMLDataBindingCmdLine.dpr +++ b/X2XMLDataBindingCmdLine.dpr @@ -6,7 +6,10 @@ uses DelphiXMLDataBindingGenerator in 'Units\DelphiXMLDataBindingGenerator.pas', XMLDataBindingGenerator in 'Units\XMLDataBindingGenerator.pas', XMLDataBindingHelpers in 'Units\XMLDataBindingHelpers.pas', - DelphiXMLDataBindingResources in 'Units\DelphiXMLDataBindingResources.pas'; + DelphiXMLDataBindingResources in 'Units\DelphiXMLDataBindingResources.pas', + xml_ExternalLeadFeed in '..\xml_ExternalLeadFeed.pas', + xml_Offerte in '..\..\xtx\xtx\xsd\xml_Offerte.pas'; + begin CoInitialize(nil); @@ -16,6 +19,11 @@ begin OutputType := otSingle; OutputPath := ParamStr(2); + if DirectoryExists(OutputPath) then + OutputType := otMultiple + else + OutputType := otSingle; + Execute(ParamStr(1)); finally Free();