From cb781049c792bef80851c982d2418ac787240359 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Tue, 22 Jun 2010 08:27:28 +0000 Subject: [PATCH] Added: support for a typed NodeValue property on typed elements with attributes --- Forms/MainFrm.pas | 23 ++- Units/DelphiXMLDataBindingGenerator.pas | 71 ++++--- Units/DelphiXMLDataBindingResources.pas | 38 +++- Units/XMLDataBindingGenerator.pas | 247 +++++++++++++++++------- Units/XMLDataBindingHelpers.pas | 21 +- X2XMLDataBinding.dpr | 1 + X2XMLDataBinding.dproj | 38 +--- 7 files changed, 280 insertions(+), 159 deletions(-) diff --git a/Forms/MainFrm.pas b/Forms/MainFrm.pas index cf19d9c..f43e9a9 100644 --- a/Forms/MainFrm.pas +++ b/Forms/MainFrm.pas @@ -62,7 +62,7 @@ type procedure feSchemaPropertiesChange(Sender: TObject); procedure btnHintsClick(Sender: TObject); private - function CheckValidSchemaFile(): Boolean; + function CheckValidSchemaFile: Boolean; function CheckReadOnly(const AFileName: String): Boolean; procedure GetFileName(Sender: TObject; const SchemaName: String; var Path, FileName: String); @@ -123,7 +123,7 @@ var begin plOutput.ActivePageIndex := 0; - if ParamCount() > 0 then + if ParamCount > 0 then begin schemaFile := ParamStr(1); @@ -156,7 +156,7 @@ var generator: THintsDelphiXMLDataBindingGenerator; begin - if not CheckValidSchemaFile() then + if not CheckValidSchemaFile then Exit; hintsFile := ChangeFileExt(feSchema.Text, '.hints.xml'); @@ -164,7 +164,7 @@ begin hints := LoadDataBindingHints(hintsFile); try - generator := THintsDelphiXMLDataBindingGenerator.Create(); + generator := THintsDelphiXMLDataBindingGenerator.Create; try generator.Hints := hints; @@ -198,7 +198,7 @@ end; procedure TMainForm.btnCloseClick(Sender: TObject); begin - Close(); + Close; end; @@ -212,7 +212,7 @@ end; procedure TMainForm.feFilePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); begin - if dlgOutputFile.Execute() then + if dlgOutputFile.Execute then feFile.Text := dlgOutputFile.FileName; end; @@ -229,7 +229,7 @@ end; procedure TMainForm.feSchemaPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); begin - if dlgSchema.Execute() then + if dlgSchema.Execute then feSchema.Text := dlgSchema.FileName; end; @@ -296,7 +296,7 @@ begin if FileExists(fileName) then settings := LoadDataBindingSettings(fileName) else - settings := NewDataBindingSettings(); + settings := NewDataBindingSettings; settings.Output.ChildNodes.Clear; @@ -318,7 +318,7 @@ begin end; -function TMainForm.CheckValidSchemaFile(): Boolean; +function TMainForm.CheckValidSchemaFile: Boolean; begin Result := FileExists(feSchema.Text); @@ -356,7 +356,7 @@ var hints: IXMLDataBindingHints; begin - if CheckValidSchemaFile() then + if CheckValidSchemaFile then begin hintsFile := ChangeFileExt(feSchema.Text, '.hints.xml'); if FileExists(hintsFile) then @@ -366,7 +366,7 @@ begin Exit; end; - hints := NewDataBindingHints(); + hints := NewDataBindingHints; hints.OwnerDocument.SaveToFile(hintsFile); ShowMessage('The hints file has been generated.'); end; @@ -649,4 +649,3 @@ end; end. - diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas index 1f9993e..969e232 100644 --- a/Units/DelphiXMLDataBindingGenerator.pas +++ b/Units/DelphiXMLDataBindingGenerator.pas @@ -22,7 +22,7 @@ type function GetItem(Index: Integer): TXMLDataBindingSchema; procedure SetItem(Index: Integer; const Value: TXMLDataBindingSchema); public - constructor Create(); + constructor Create; property Items[Index: Integer]: TXMLDataBindingSchema read GetItem write SetItem; default; end; @@ -35,7 +35,7 @@ type FOnGetFileName: TGetFileNameEvent; protected - procedure GenerateDataBinding(); override; + procedure GenerateDataBinding; override; procedure GenerateOutputFile(ASchemaList: TXMLSchemaList; const ASourceFileName, AUnitName: String); function GenerateUsesClause(ASchemaList: TXMLSchemaList): String; @@ -48,7 +48,7 @@ type function GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean; function GetDataTypeName(AProperty: TXMLDataBindingProperty; AInterfaceName: Boolean): String; function TranslateDataType(ADataType: IXMLTypeDef): String; - function CreateNewGUID(): String; + function CreateNewGUID: String; procedure WriteUnitHeader(AStream: TStreamHelper; const ASourceFileName, AFileName: String); procedure WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection; ASchemaList: TXMLSchemaList); @@ -88,7 +88,7 @@ uses { TDelphiXMLDataBindingGenerator } -procedure TDelphiXMLDataBindingGenerator.GenerateDataBinding(); +procedure TDelphiXMLDataBindingGenerator.GenerateDataBinding; var schemaList: TXMLSchemaList; schemaIndex: Integer; @@ -96,7 +96,7 @@ var unitName: String; begin - schemaList := TXMLSchemaList.Create(); + schemaList := TXMLSchemaList.Create; try case OutputType of otSingle: @@ -110,7 +110,7 @@ begin otMultiple: begin - FUnitNames := TX2OSHash.Create(); + FUnitNames := TX2OSHash.Create; try for schemaIndex := 0 to Pred(SchemaCount) do begin @@ -122,7 +122,7 @@ begin begin schema := Schemas[schemaIndex]; - schemaList.Clear(); + schemaList.Clear; schemaList.Add(schema); unitName := FUnitNames[schema]; @@ -158,12 +158,12 @@ begin ['UsesClause', usesClause]); WriteSection(unitStream, dxsForward, ASchemaList); - FProcessedItems := TX2OIHash.Create(); + FProcessedItems := TX2OIHash.Create; try - FProcessedItems.Clear(); + FProcessedItems.Clear; WriteSection(unitStream, dxsInterface, ASchemaList); - FProcessedItems.Clear(); + FProcessedItems.Clear; WriteSection(unitStream, dxsClass, ASchemaList); finally FreeAndNil(FProcessedItems); @@ -441,7 +441,7 @@ begin hasItem := True; end; - with TNamedFormatStringList.Create() do + with TNamedFormatStringList.Create do try case ASection of dxsInterface: Add(DocumentFunctionsInterface); @@ -451,10 +451,10 @@ begin AStream.Write(Format(['SourceName', interfaceItem.Name, 'Name', interfaceItem.TranslatedName])); finally - Free(); + Free; end; - AStream.WriteLn(); + AStream.WriteLn; end; end; end; @@ -464,8 +464,8 @@ begin begin AStream.WriteLn('const'); AStream.WriteLnFmt(' TargetNamespace = ''%s'';', [nameSpace]); - AStream.WriteLn(); - AStream.WriteLn(); + AStream.WriteLn; + AStream.WriteLn; end; end; @@ -529,7 +529,7 @@ begin if ASection = dxsInterface then indent := ' '; - sourceCode := TNamedFormatStringList.Create(); + sourceCode := TNamedFormatStringList.Create; try sourceCode.Add(indent + 'function StringTo%:s(const AValue: WideString): %:s;'); @@ -640,7 +640,7 @@ begin if not AItem.HasDocumentation then exit; - lines := TStringList.Create(); + lines := TStringList.Create; try documentation := AItem.Documentation; @@ -708,12 +708,12 @@ begin AStream.WriteLnNamedFmt(InterfaceItemInterface, ['Name', AItem.TranslatedName, 'ParentName', parent]); - AStream.WriteLn(' ' + CreateNewGUID()); + AStream.WriteLn(' ' + CreateNewGUID); WriteSchemaInterfaceProperties(AStream, AItem, ASection); AStream.WriteLn(' end;'); - AStream.WriteLn(); + AStream.WriteLn; end; dxsClass: @@ -733,7 +733,7 @@ begin WriteSchemaInterfaceProperties(AStream, AItem, ASection); AStream.WriteLn(' end;'); - AStream.WriteLn(); + AStream.WriteLn; end; dxsImplementation: @@ -749,7 +749,7 @@ var hasPrototype: Boolean; - procedure WritePrototype(); + procedure WritePrototype; begin if not hasPrototype then begin @@ -977,7 +977,7 @@ begin end; end; - sourceCode := TNamedFormatStringList.Create(); + sourceCode := TNamedFormatStringList.Create; try case ASection of dxsInterface, @@ -1149,7 +1149,7 @@ begin Exit; - sourceCode := TNamedFormatStringList.Create(); + sourceCode := TNamedFormatStringList.Create; try case ASection of dxsInterface, @@ -1235,7 +1235,10 @@ begin sourceCode.Add(PropertyImplMethodGetNil); if writeTextProp then - sourceCode.Add(PropertyImplMethodGetText); + if AProperty.IsAttribute then + sourceCode.Add(PropertyImplMethodGetTextAttr) + else + sourceCode.Add(PropertyImplMethodGetText); sourceCode.Add('function TXML%:s.Get%:s: %:s;'); @@ -1294,7 +1297,10 @@ begin sourceCode.Add(PropertyImplMethodSetNil); if writeTextProp then - sourceCode.Add(PropertyImplMethodSetText); + if AProperty.IsAttribute then + sourceCode.Add(PropertyImplMethodSetTextAttr) + else + sourceCode.Add(PropertyImplMethodSetText); sourceCode.Add('procedure TXML%:s.Set%:s(const Value: %:s);'); value := '%:s'; @@ -1394,11 +1400,11 @@ begin if memberIndex < Pred(AItem.MemberCount) then AStream.WriteLn(',') else - AStream.WriteLn(); + AStream.WriteLn; end; AStream.WriteLn(lineIndent + ');'); - AStream.WriteLn(); + AStream.WriteLn; end; @@ -1406,6 +1412,8 @@ function TDelphiXMLDataBindingGenerator.GetDelphiNodeType(AProperty: TXMLDataBin begin if AProperty.IsAttribute then Result := dntAttribute + else if AProperty.IsNodeValue then + Result := dntNodeValue else Result := dntElement; end; @@ -1417,7 +1425,7 @@ var conversion: String; begin - with TNamedFormatStringList.Create() do + with TNamedFormatStringList.Create do try if not (Assigned(ADataType) and GetDataTypeMapping(ADataType, typeMapping)) then typeMapping.Conversion := tcNone; @@ -1440,7 +1448,7 @@ begin Result := Trim(Format(['Destination', ADestination, 'Source', ASource])); finally - Free(); + Free; end; end; @@ -1457,7 +1465,7 @@ begin end; -function TDelphiXMLDataBindingGenerator.CreateNewGUID(): String; +function TDelphiXMLDataBindingGenerator.CreateNewGUID: String; var guid: TGUID; @@ -1489,7 +1497,7 @@ end; { TXMLSchemaList } -constructor TXMLSchemaList.Create(); +constructor TXMLSchemaList.Create; begin inherited Create(False); end; @@ -1509,4 +1517,3 @@ end; end. - diff --git a/Units/DelphiXMLDataBindingResources.pas b/Units/DelphiXMLDataBindingResources.pas index 8a69e2f..8f42a80 100644 --- a/Units/DelphiXMLDataBindingResources.pas +++ b/Units/DelphiXMLDataBindingResources.pas @@ -5,7 +5,7 @@ type TDelphiXMLSection = (dxsForward, dxsInterface, dxsClass, dxsImplementation); TDelphiXMLMember = (dxmPropertyGet, dxmPropertySet, dxmPropertyDeclaration); TDelphiAccessor = (daGet, daSet); - TDelphiNodeType = (dntElement, dntAttribute, dntCustom); + TDelphiNodeType = (dntElement, dntAttribute, dntNodeValue, dntCustom); const @@ -116,12 +116,24 @@ const 'end;' + CrLf + '' + CrLf; + PropertyImplMethodGetTextAttr = 'function TXML%:s.Get%:sText: WideString;' + CrLf + + 'begin' + CrLf + + ' Result := AttributeNodes[''%:s''].Text;' + CrLf + + 'end;' + CrLf + + '' + CrLf; + PropertyImplMethodSetText = 'procedure TXML%:s.Set%:sText(const Value: WideString);' + CrLf + 'begin' + CrLf + ' ChildNodes[''%:s''].NodeValue := Value;' + CrLf + 'end;' + CrLf + '' + CrLf; + PropertyImplMethodSetTextAttr = 'procedure TXML%:s.Set%:sText(const Value: WideString);' + CrLf + + 'begin' + CrLf + + ' AttributeNodes[''%:s''].NodeValue := Value;' + CrLf + + 'end;' + CrLf + + '' + CrLf; + SectionComments: array[TDelphiXMLSection] of String = ( @@ -236,12 +248,14 @@ const ( { dntElement } ' %:s := ChildNodes[''%:s''].NodeValue;', { dntAttribute } ' %:s := AttributeNodes[''%:s''].NodeValue;', + { dntNodeValue } ' %:s := NodeValue;', { dntCustom } ' %:s := %:s;' ), { daSet } ( { dntElement } ' ChildNodes[''%:s''].NodeValue := %:s;', { dntAttribute } ' SetAttribute(''%:s'', %:s);', + { dntNodeValue } ' NodeValue := %:s;', { dntCustom } ' %:s := %:s;' ) ); @@ -273,6 +287,17 @@ const { tcString } ' %:s := AttributeNodes[''%:s''].Text;', { tcBase64 } ' %:s := Base64Decode(Trim(AttributeNodes[''%:s''].Text));' ), + { dntNodeValue } + ( + { tcNone } '', + { tcBoolean } '', + { tcFloat } ' %:s := XMLToFloat(NodeValue);', + { tcDateTime } ' %:s := XMLToDateTime(NodeValue, xdtDateTime);', + { tcDate } ' %:s := XMLToDateTime(NodeValue, xdtDate);', + { tcTime } ' %:s := XMLToDateTime(NodeValue, xdtTime);', + { tcString } ' %:s := NodeValue;', + { tcBase64 } ' %:s := Base64Decode(Trim(NodeValue));' + ), { dntCustom} ( { tcNone } '', @@ -309,6 +334,17 @@ const { tcString } '', { tcBase64 } ' SetAttribute(''%:s'', Base64Encode(%:s));' ), + { dntNodeValue } + ( + { tcNone } '', + { tcBoolean } ' NodeValue := BoolToXML(%:s);', + { tcFloat } ' NodeValue := FloatToXML(%:s);', + { tcDateTime } ' NodeValue := DateTimeToXML(%:s, xdtDateTime);', + { tcDate } ' NodeValue := DateTimeToXML(%:s, xdtDate);', + { tcTime } ' NodeValue := DateTimeToXML(%:s, xdtTime);', + { tcString } '', + { tcBase64 } ' NodeValue := Base64Encode(%:s);' + ), { dntCustom} ( { tcNone } '', diff --git a/Units/XMLDataBindingGenerator.pas b/Units/XMLDataBindingGenerator.pas index 8f14e2f..a6626ac 100644 --- a/Units/XMLDataBindingGenerator.pas +++ b/Units/XMLDataBindingGenerator.pas @@ -44,7 +44,7 @@ type FOnPostProcessItem: TXMLDataBindingPostProcessItemEvent; - function GetSchemaCount(): Integer; + function GetSchemaCount: Integer; function GetSchemas(Index: Integer): TXMLDataBindingSchema; protected function LoadSchema(const AStream: TStream; const ASchemaName: String): TXMLDataBindingSchema; @@ -61,7 +61,8 @@ type function IsElementRepeating(AElement: IXMLElementDef): Boolean; function IsChoice(AElement: IXMLElementDef): Boolean; - function ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem; + function ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem; overload; + function ProcessElement(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef): TXMLDataBindingItem; overload; procedure ProcessChildElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef; AInterface: TXMLDataBindingInterface); procedure ProcessAttribute(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef; AInterface: TXMLDataBindingInterface); @@ -78,20 +79,20 @@ type procedure ResolveSchema(ASchema: TXMLDataBindingSchema); procedure ResolveAlias(ASchema: TXMLDataBindingSchema); procedure ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingUnresolvedItem); - procedure ResolveNameConflicts(); + procedure ResolveNameConflicts; procedure PostProcessSchema(ASchema: TXMLDataBindingSchema); procedure PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); function TranslateItemName(AItem: TXMLDataBindingItem): String; virtual; - procedure GenerateDataBinding(); virtual; abstract; + procedure GenerateDataBinding; virtual; abstract; property SourceFileName: String read FSourceFileName write FSourceFileName; property SchemaCount: Integer read GetSchemaCount; property Schemas[Index: Integer]: TXMLDataBindingSchema read GetSchemas; public - constructor Create(); - destructor Destroy(); override; + constructor Create; + destructor Destroy; override; procedure Execute(const AStream: TStream; const ASchemaName: String); overload; procedure Execute(const AFileName: String); overload; @@ -125,9 +126,9 @@ type FSchemaName: String; FSourceFileName: String; - function GetItemCount(): Integer; + function GetItemCount: Integer; function GetItems(Index: Integer): TXMLDataBindingItem; - function GetIncludeCount(): Integer; + function GetIncludeCount: Integer; function GetIncludes(Index: Integer): TXMLDataBindingSchema; function GetTargetNamespace: String; protected @@ -140,7 +141,7 @@ type property ItemsGenerated: Boolean read FItemsGenerated write FItemsGenerated; public constructor Create(AOwner: TXMLDataBindingGenerator); - destructor Destroy(); override; + destructor Destroy; override; property TargetNamespace: String read GetTargetNamespace; @@ -165,11 +166,11 @@ type FSchemaItem: IXMLSchemaItem; FTranslatedName: String; - function GetDocumentation(): String; - function GetHasDocumentation(): Boolean; + function GetDocumentation: String; + function GetHasDocumentation: Boolean; function GetIsCollection: Boolean; protected - function GetItemType(): TXMLDataBindingItemType; virtual; abstract; + function GetItemType: TXMLDataBindingItemType; virtual; abstract; procedure SetName(const Value: String); property SchemaItem: IXMLSchemaItem read FSchemaItem; @@ -200,7 +201,7 @@ type function GetProperties(Index: Integer): TXMLDataBindingProperty; function GetPropertyCount: Integer; protected - function GetItemType(): TXMLDataBindingItemType; override; + function GetItemType: TXMLDataBindingItemType; override; procedure ReplaceItem(const AOldItem: TXMLDataBindingItem; const ANewItem: TXMLDataBindingItem); override; @@ -223,7 +224,7 @@ type private FEnumeration: TXMLDataBindingEnumeration; protected - function GetItemType(): TXMLDataBindingItemType; override; + function GetItemType: TXMLDataBindingItemType; override; public constructor Create(AOwner: TXMLDataBindingGenerator; AEnumeration: TXMLDataBindingEnumeration; const AName: String); @@ -235,13 +236,13 @@ type private FMembers: TObjectList; - function GetMemberCount(): Integer; + function GetMemberCount: Integer; function GetMembers(Index: Integer): TXMLDataBindingEnumerationMember; protected - function GetItemType(): TXMLDataBindingItemType; override; + function GetItemType: TXMLDataBindingItemType; override; public constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; AEnumerations: IXMLEnumerationCollection; const AName: String); - destructor Destroy(); override; + destructor Destroy; override; property MemberCount: Integer read GetMemberCount; property Members[Index: Integer]: TXMLDataBindingEnumerationMember read GetMembers; @@ -254,18 +255,20 @@ type FIsOptional: Boolean; FIsNillable: Boolean; FIsRepeating: Boolean; + FIsNodeValue: Boolean; FCollection: TXMLDataBindingInterface; protected - function GetIsReadOnly(): Boolean; virtual; abstract; + function GetIsReadOnly: Boolean; virtual; abstract; - function GetItemType(): TXMLDataBindingItemType; override; - function GetPropertyType(): TXMLDataBindingPropertyType; 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 IsNillable: Boolean read FIsNillable write FIsNillable; property IsReadOnly: Boolean read GetIsReadOnly; property IsRepeating: Boolean read FIsRepeating write FIsRepeating; + property IsNodeValue: Boolean read FIsNodeValue write FIsNodeValue; property PropertyType: TXMLDataBindingPropertyType read GetPropertyType; property Collection: TXMLDataBindingInterface read FCollection write FCollection; @@ -276,8 +279,8 @@ type private FDataType: IXMLTypeDef; protected - function GetIsReadOnly(): Boolean; override; - function GetPropertyType(): TXMLDataBindingPropertyType; override; + function GetIsReadOnly: Boolean; override; + function GetPropertyType: TXMLDataBindingPropertyType; override; public constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; ADataType: IXMLTypeDef); constructor CreateFromAlias(AOwner: TXMLDataBindingGenerator; AProperty: TXMLDataBindingItemProperty; ADataType: IXMLTypeDef); @@ -290,8 +293,8 @@ type private FItem: TXMLDataBindingItem; protected - function GetIsReadOnly(): Boolean; override; - function GetPropertyType(): TXMLDataBindingPropertyType; override; + function GetIsReadOnly: Boolean; override; + function GetPropertyType: TXMLDataBindingPropertyType; override; procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); override; public @@ -305,7 +308,7 @@ type private FInterfaceType: TXMLDataBindingInterfaceType; protected - function GetItemType(): TXMLDataBindingItemType; override; + function GetItemType: TXMLDataBindingItemType; override; public constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType); @@ -317,7 +320,7 @@ type private FItem: TXMLDataBindingItem; protected - function GetItemType(): TXMLDataBindingItemType; override; + function GetItemType: TXMLDataBindingItemType; override; procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); override; public @@ -329,7 +332,7 @@ type private FDataType: IXMLTypeDef; protected - function GetItemType(): TXMLDataBindingItemType; override; + function GetItemType: TXMLDataBindingItemType; override; public property DataType: IXMLTypeDef read FDataType write FDataType; end; @@ -354,7 +357,6 @@ const AttributeNillable = 'nillable'; - function GetInterfaceType(ASchemaItem: IXMLSchemaItem): TXMLDataBindingInterfaceType; begin if Supports(ASchemaItem, IXMLComplexTypeDef) then @@ -366,11 +368,11 @@ end; { TXMLDataBindingGenerator } -constructor TXMLDataBindingGenerator.Create(); +constructor TXMLDataBindingGenerator.Create; begin - inherited Create(); + inherited Create; - FIncludePaths := TStringList.Create(); + FIncludePaths := TStringList.Create; FSchemas := TObjectList.Create(True); with TStringList(FIncludePaths) do @@ -381,7 +383,7 @@ begin end; -destructor TXMLDataBindingGenerator.Destroy(); +destructor TXMLDataBindingGenerator.Destroy; begin FreeAndNil(FSchemas); FreeAndNil(FIncludePaths); @@ -396,7 +398,7 @@ var schema: TXMLDataBindingSchema; begin - FSchemas.Clear(); + FSchemas.Clear; schema := LoadSchema(AStream, ASchemaName); if Assigned(schema) then schema.SourceFileName := SourceFileName; @@ -419,7 +421,7 @@ begin { Resolve naming conflicts } - ResolveNameConflicts(); + ResolveNameConflicts; { Perform final post-processing (translating names, generating collections) } @@ -428,7 +430,7 @@ begin { Output } - GenerateDataBinding(); + GenerateDataBinding; end; end; @@ -439,7 +441,7 @@ var fileStream: TFileStream; begin - currentDir := GetCurrentDir(); + currentDir := GetCurrentDir; try ChDir(ExtractFilePath(AFileName)); @@ -816,6 +818,97 @@ begin end; +function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef): TXMLDataBindingItem; +var + enumerationObject: TXMLDataBindingEnumeration; + interfaceObject: TXMLDataBindingInterface; + complexAliasItem: TXMLDataBindingComplexTypeAliasItem; + simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem; + simpleTypeDef: IXMLSimpleTypeDef; + +begin + Result := nil; + + if Assigned(AAttribute.Ref) then + begin + { Find reference. If not found, mark as "resolve later". } + Result := FindInterface(ASchema, AAttribute.Ref.Name, ifElement); + + if not Assigned(Result) then + begin + Result := TXMLDataBindingUnresolvedItem.Create(Self, AAttribute, AAttribute.Ref.Name, ifElement); + ASchema.AddItem(Result); + end; + end else + begin + if not AAttribute.DataType.IsAnonymous then + begin + if AAttribute.DataType.IsComplex then + begin + { Find data type. If not found, mark as "resolve later". } + Result := FindInterface(ASchema, AAttribute.DataTypeName, ifComplexType); + + if not Assigned(Result) then + begin + Result := TXMLDataBindingUnresolvedItem.Create(Self, AAttribute, AAttribute.DataTypeName, ifComplexType); + ASchema.AddItem(Result); + end; + + if AAttribute.IsGlobal then + begin + { The element is global, but only references a complex type. Keep track + to properly resolve references to the element. } + complexAliasItem := TXMLDataBindingComplexTypeAliasItem.Create(Self, AAttribute, AAttribute.Name); + complexAliasItem.Item := Result; + ASchema.AddItem(complexAliasItem); + end; + end else if Supports(AAttribute.DataType, IXMLSimpleTypeDef, simpleTypeDef) then + begin + if simpleTypeDef.Enumerations.Count > 0 then + begin + { References enumeration. } + Result := FindEnumeration(ASchema, AAttribute.DataTypeName); + + if not Assigned(Result) then + begin + Result := TXMLDataBindingUnresolvedItem.Create(Self, AAttribute, AAttribute.DataTypeName, ifEnumeration); + ASchema.AddItem(Result); + end; + end else if simpleTypeDef.IsBuiltInType and AAttribute.IsGlobal then + begin + { The element is global, but only references a simple type. } + simpleAliasItem := TXMLDataBindingSimpleTypeAliasItem.Create(Self, AAttribute, AAttribute.Name); + simpleAliasItem.DataType := AAttribute.DataType; + ASchema.AddItem(simpleAliasItem); + + Result := simpleAliasItem; + end; + end; + end; + + if not Assigned(Result) then + begin + if AAttribute.DataType.Enumerations.Count > 0 then + begin + { Enumeration } + enumerationObject := TXMLDataBindingEnumeration.Create(Self, AAttribute, AAttribute.DataType.Enumerations, AAttribute.Name); + ASchema.AddItem(enumerationObject); + Result := enumerationObject; + end else if AAttribute.DataType.IsComplex then + begin + { Interface } + interfaceObject := TXMLDataBindingInterface.Create(Self, AAttribute, AAttribute.Name); + if Assigned(AAttribute.DataType.BaseType) then + interfaceObject.BaseName := AAttribute.DataType.BaseTypeName; + + ASchema.AddItem(interfaceObject); + Result := interfaceObject; + end; + end; + end; +end; + + procedure TXMLDataBindingGenerator.ProcessChildElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef; AInterface: TXMLDataBindingInterface); var actualElement: IXMLElementDef; @@ -858,12 +951,19 @@ end; procedure TXMLDataBindingGenerator.ProcessAttribute(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef; AInterface: TXMLDataBindingInterface); var propertyItem: TXMLDataBindingProperty; + propertyType: TXMLDataBindingItem; begin - // #ToDo2 (MvR) 10-4-2008: complex attributes (enumerations) - propertyItem := TXMLDataBindingSimpleProperty.Create(Self, AAttribute, + propertyType := ProcessElement(ASchema, AAttribute); + + if Assigned(propertyType) then + propertyItem := TXMLDataBindingItemProperty.Create(Self, AAttribute, AAttribute.Name, - AAttribute.DataType); + propertyType) + else + propertyItem := TXMLDataBindingSimpleProperty.Create(Self, AAttribute, + AAttribute.Name, + AAttribute.DataType); propertyItem.IsOptional := (AAttribute.Use = UseOptional); propertyItem.IsAttribute := True; @@ -1073,7 +1173,7 @@ begin end; -procedure TXMLDataBindingGenerator.ResolveNameConflicts(); +procedure TXMLDataBindingGenerator.ResolveNameConflicts; var itemNames: TX2SOHash; @@ -1159,9 +1259,9 @@ begin { Find conflicts } - itemNames.First(); + itemNames.First; - while itemNames.Next() do + while itemNames.Next do begin items := TObjectList(itemNames.CurrentValue); @@ -1221,6 +1321,7 @@ var propertyIndex: Integer; propertyItem: TXMLDataBindingProperty; repeatingItems: TObjectList; + typedSchemaItem: IXMLTypedSchemaItem; begin { Translate name } @@ -1288,6 +1389,21 @@ begin begin interfaceItem := TXMLDataBindingInterface(AItem); + if (not Assigned(interfaceItem.BaseItem)) and + (Length(interfaceItem.BaseName) > 0) then + begin + { Assume this is a reference to a simple type } + if Supports(interfaceItem.SchemaItem, IXMLTypedSchemaItem, typedSchemaItem) then + begin + propertyItem := TXMLDataBindingSimpleProperty.Create(Self, interfaceItem.SchemaItem, 'NodeValue', + typedSchemaItem.DataType.BaseType); + propertyItem.IsNodeValue := True; + + interfaceItem.AddProperty(propertyItem); + end; + end; + + for propertyIndex := 0 to Pred(interfaceItem.PropertyCount) do PostProcessItem(ASchema, interfaceItem.Properties[propertyIndex]); end; @@ -1308,7 +1424,7 @@ begin end; -function TXMLDataBindingGenerator.GetSchemaCount(): Integer; +function TXMLDataBindingGenerator.GetSchemaCount: Integer; begin Result := FSchemas.Count; end; @@ -1323,7 +1439,7 @@ end; { TXMLDataBindingGeneratorItem } constructor TXMLDataBindingGeneratorItem.Create(AOwner: TXMLDataBindingGenerator); begin - inherited Create(); + inherited Create; FOwner := AOwner; end; @@ -1344,7 +1460,7 @@ begin end; -destructor TXMLDataBindingSchema.Destroy(); +destructor TXMLDataBindingSchema.Destroy; begin FreeAndNil(FItems); FreeAndNil(FIncludes); @@ -1403,7 +1519,7 @@ begin end; -function TXMLDataBindingSchema.GetIncludeCount(): Integer; +function TXMLDataBindingSchema.GetIncludeCount: Integer; begin Result := FIncludes.Count; end; @@ -1415,7 +1531,7 @@ begin end; -function TXMLDataBindingSchema.GetItemCount(): Integer; +function TXMLDataBindingSchema.GetItemCount: Integer; begin Result := FItems.Count; end; @@ -1427,7 +1543,7 @@ begin end; -function TXMLDataBindingSchema.GetTargetNamespace(): String; +function TXMLDataBindingSchema.GetTargetNamespace: String; begin Result := ''; if Assigned(FSchemaDef) and (not VarIsNull(FSchemaDef.TargetNamespace)) then @@ -1446,7 +1562,7 @@ begin end; -function TXMLDataBindingItem.GetDocumentation(): String; +function TXMLDataBindingItem.GetDocumentation: String; var documentationIndex: Integer; @@ -1462,14 +1578,14 @@ begin end; -function TXMLDataBindingItem.GetHasDocumentation(): Boolean; +function TXMLDataBindingItem.GetHasDocumentation: Boolean; begin Result := Assigned(SchemaItem) and (SchemaItem.Documentation.Count > 0); end; -function TXMLDataBindingItem.GetIsCollection(): Boolean; +function TXMLDataBindingItem.GetIsCollection: Boolean; begin Result := Assigned(FCollectionItem); end; @@ -1544,13 +1660,13 @@ begin end; -function TXMLDataBindingInterface.GetItemType(): TXMLDataBindingItemType; +function TXMLDataBindingInterface.GetItemType: TXMLDataBindingItemType; begin Result := itInterface; end; -function TXMLDataBindingInterface.GetPropertyCount(): Integer; +function TXMLDataBindingInterface.GetPropertyCount: Integer; begin Result := FProperties.Count; end; @@ -1571,7 +1687,7 @@ begin end; -function TXMLDataBindingEnumerationMember.GetItemType(): TXMLDataBindingItemType; +function TXMLDataBindingEnumerationMember.GetItemType: TXMLDataBindingItemType; begin Result := itEnumerationMember; end; @@ -1585,14 +1701,14 @@ var begin inherited Create(AOwner, ASchemaItem, AName); - FMembers := TObjectList.Create(); + FMembers := TObjectList.Create; for memberIndex := 0 to Pred(AEnumerations.Count) do FMembers.Add(TXMLDataBindingEnumerationMember.Create(Owner, Self, AEnumerations.Items[memberIndex].Value)); end; -destructor TXMLDataBindingEnumeration.Destroy(); +destructor TXMLDataBindingEnumeration.Destroy; begin FreeAndNil(FMembers); @@ -1600,13 +1716,13 @@ begin end; -function TXMLDataBindingEnumeration.GetItemType(): TXMLDataBindingItemType; +function TXMLDataBindingEnumeration.GetItemType: TXMLDataBindingItemType; begin Result := itEnumeration; end; -function TXMLDataBindingEnumeration.GetMemberCount(): Integer; +function TXMLDataBindingEnumeration.GetMemberCount: Integer; begin Result := FMembers.Count; end; @@ -1619,7 +1735,7 @@ end; { TXMLDataBindingProperty } -function TXMLDataBindingProperty.GetItemType(): TXMLDataBindingItemType; +function TXMLDataBindingProperty.GetItemType: TXMLDataBindingItemType; begin Result := itProperty; end; @@ -1645,13 +1761,13 @@ begin end; -function TXMLDataBindingSimpleProperty.GetIsReadOnly(): Boolean; +function TXMLDataBindingSimpleProperty.GetIsReadOnly: Boolean; begin Result := False; end; -function TXMLDataBindingSimpleProperty.GetPropertyType(): TXMLDataBindingPropertyType; +function TXMLDataBindingSimpleProperty.GetPropertyType: TXMLDataBindingPropertyType; begin Result := ptSimple; end; @@ -1675,13 +1791,13 @@ begin end; -function TXMLDataBindingItemProperty.GetIsReadOnly(): Boolean; +function TXMLDataBindingItemProperty.GetIsReadOnly: Boolean; begin Result := Assigned(Item) and (Item.ItemType <> itEnumeration); end; -function TXMLDataBindingItemProperty.GetPropertyType(): TXMLDataBindingPropertyType; +function TXMLDataBindingItemProperty.GetPropertyType: TXMLDataBindingPropertyType; begin Result := ptItem; end; @@ -1696,7 +1812,7 @@ begin end; -function TXMLDataBindingUnresolvedItem.GetItemType(): TXMLDataBindingItemType; +function TXMLDataBindingUnresolvedItem.GetItemType: TXMLDataBindingItemType; begin Result := itUnresolved; end; @@ -1712,7 +1828,7 @@ begin end; -function TXMLDataBindingComplexTypeAliasItem.GetItemType(): TXMLDataBindingItemType; +function TXMLDataBindingComplexTypeAliasItem.GetItemType: TXMLDataBindingItemType; begin Result := itComplexTypeAlias; end; @@ -1728,4 +1844,3 @@ end. - diff --git a/Units/XMLDataBindingHelpers.pas b/Units/XMLDataBindingHelpers.pas index f68cffe..5a46342 100644 --- a/Units/XMLDataBindingHelpers.pas +++ b/Units/XMLDataBindingHelpers.pas @@ -11,12 +11,12 @@ type FStream: TStream; public constructor Create(AStream: TStream; AOwnership: TStreamOwnership = soReference); - destructor Destroy(); override; + destructor Destroy; override; function ReadString(ASize: Integer = -1): String; - function ReadInteger(): Integer; - function ReadDateTime(): TDateTime; - function ReadBoolean(): Boolean; + function ReadInteger: Integer; + function ReadDateTime: TDateTime; + function ReadBoolean: Boolean; procedure Write(const ASource: String); procedure WriteLn(const ASource: String = ''); @@ -47,11 +47,11 @@ begin FOwnership := AOwnership; FStream := AStream; - inherited Create(); + inherited Create; end; -destructor TStreamHelper.Destroy(); +destructor TStreamHelper.Destroy; begin if FOwnership = soOwned then FreeAndNil(FStream); @@ -66,7 +66,7 @@ var begin if ASize = -1 then - iSize := ReadInteger() + iSize := ReadInteger else iSize := ASize; @@ -75,19 +75,19 @@ begin end; -function TStreamHelper.ReadInteger(): Integer; +function TStreamHelper.ReadInteger: Integer; begin FStream.Read(Result, SizeOf(Integer)); end; -function TStreamHelper.ReadDateTime(): TDateTime; +function TStreamHelper.ReadDateTime: TDateTime; begin FStream.Read(Result, SizeOf(TDateTime)); end; -function TStreamHelper.ReadBoolean(): Boolean; +function TStreamHelper.ReadBoolean: Boolean; begin FStream.Read(Result, SizeOf(Boolean)); end; @@ -159,4 +159,3 @@ end; end. - diff --git a/X2XMLDataBinding.dpr b/X2XMLDataBinding.dpr index dd03bb1..a8200bc 100644 --- a/X2XMLDataBinding.dpr +++ b/X2XMLDataBinding.dpr @@ -3,6 +3,7 @@ program X2XMLDataBinding; {$WARN SYMBOL_PLATFORM OFF} uses + VistaManAsInvoker, Forms, MainFrm in 'Forms\MainFrm.pas' {MainForm}, XMLDataBindingGenerator in 'Units\XMLDataBindingGenerator.pas', diff --git a/X2XMLDataBinding.dproj b/X2XMLDataBinding.dproj index 99a9084..17ad493 100644 --- a/X2XMLDataBinding.dproj +++ b/X2XMLDataBinding.dproj @@ -24,43 +24,7 @@ Delphi.Personality - - - False - True - False - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1043 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - X2XMLDataBinding.dpr - - +FalseTrueFalse"P:\test\XMLDataBinding\Tests\Data\04. Type with attributes.xsd"FalseFalse1000FalseFalseFalseFalseFalse104312521.0.0.01.0.0.0X2XMLDataBinding.dpr