From 107589b83963015032a0719768c0433debdfb490 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Fri, 21 Mar 2008 15:23:14 +0000 Subject: [PATCH] Added: better support for datatype conversions Changed: extracted most strings to the Resources unit --- Units/DelphiXMLDataBindingGenerator.pas | 509 +++++++++++------------- Units/DelphiXMLDataBindingResources.pas | 213 ++++++++++ Units/XMLDataBindingGenerator.pas | 8 +- X2XMLDataBindingCmdLine.dof | 2 +- X2XMLDataBindingCmdLine.dpr | 3 +- 5 files changed, 454 insertions(+), 281 deletions(-) create mode 100644 Units/DelphiXMLDataBindingResources.pas diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas index 95836ce..bf3bc3b 100644 --- a/Units/DelphiXMLDataBindingGenerator.pas +++ b/Units/DelphiXMLDataBindingGenerator.pas @@ -7,15 +7,15 @@ uses X2UtHashes, + DelphiXMLDataBindingResources, XMLDataBindingGenerator, XMLDataBindingHelpers; + type TGetFileNameEvent = procedure(Sender: TObject; const SchemaName: String; var Result: String) of object; - TDelphiXMLSection = (dxsForward, dxsInterface, dxsClass, dxsImplementation); - TDelphiXMLMember = (dxmPropertyGet, dxmPropertySet, dxmPropertyDeclaration); - + TDelphiXMLDataBindingGenerator = class(TXMLDataBindingGenerator) private FOnGetFileName: TGetFileNameEvent; @@ -31,17 +31,16 @@ type function DoGetFileName(const ASchemaName: String): String; + function GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean; function TranslateDataType(ADataType: IXMLTypeDef): String; function CreateNewGUID(): String; procedure WriteUnitHeader(AStream: TStreamHelper; const AFileName: String); - procedure WriteInterface(AStream: TStreamHelper); - procedure WriteImplementation(AStream: TStreamHelper); - procedure WriteUnitFooter(AStream: TStreamHelper); procedure WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection); procedure WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection); procedure WriteEnumerationConstants(AStream: TStreamHelper); - procedure WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem); + procedure WriteEnumerationConversions(AStream: TStreamHelper); + procedure WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem); procedure WriteSchemaItem(AStream: TStreamHelper; AItem: TXMLDataBindingItem; ASection: TDelphiXMLSection); procedure WriteSchemaInterface(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection); @@ -51,98 +50,24 @@ type 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; + property ProcessedItems: TX2OIHash read FProcessedItems; public property OnGetFileName: TGetFileNameEvent read FOnGetFileName write FOnGetFileName; end; + implementation uses + Contnrs, SysUtils, X2UtNamedFormat; -const - SectionComments: array[TDelphiXMLSection] of String = - ( - ' { Forward declarations for %:s }', - ' { Interfaces for %:s }', - ' { Classes for %:s }', - '{ Implementation for %:s }' - ); - - - PrefixInterface = 'IXML'; - PrefixClass = 'TXML'; - - - InterfaceItemForward = ' IXML%:s = interface;'; - InterfaceItemInterface = ' IXML%:s = interface(%:s)'; - InterfaceItemClass = ' TXML%:s = class(%:s, IXML%:s)'; - - - CollectionInterface = 'IXMLNodeCollection'; - CollectionClass = 'TXMLNodeCollection'; - - ItemInterface = 'IXMLNode'; - ItemClass = 'TXMLNode'; - - - - // #ToDo1 (MvR) 9-3-2008: document / node / etc - // #ToDo1 (MvR) 9-3-2008: WideString etc ? - ReservedWords: array[0..111] of String = - ( - 'absolute', 'abstract', 'and', 'array', 'as', 'asm', - 'assembler', 'automated', 'begin', 'case', 'cdecl', 'class', - 'const', 'constructor', 'contains', 'default', 'deprecated', - 'destructor', 'dispid', 'dispinterface', 'div', 'do', - 'downto', 'dynamic', 'else', 'end', 'except', 'export', - 'exports', 'external', 'far', 'file', 'final', 'finalization', - 'finally', 'for', 'forward', 'function', 'goto', 'if', - 'implementation', 'implements', 'in', 'index', 'inherited', - 'initialization', 'inline', 'interface', 'is', 'label', - 'library', 'local', 'message', 'mod', 'name', 'near', - 'nil', 'nodefault', 'not', 'object', 'of', 'or', 'out', - 'overload', 'override', 'package', 'packed', 'pascal', - 'platform', 'private', 'procedure', 'program', 'property', - 'protected', 'public', 'published', 'raise', 'read', - 'readonly', 'record', 'register', 'reintroduce', 'repeat', - 'requires', 'resident', 'resourcestring', 'safecall', - 'sealed', 'set', 'shl', 'shr', 'static', 'stdcall', - 'stored', 'string', 'then', 'threadvar', 'to', 'try', 'type', - 'unit', 'unsafe', 'until', 'uses', 'var', 'varargs', - 'virtual', 'while', 'with', 'write', 'writeonly', 'xor' - ); - - -type - // #ToDo1 (MvR) 10-3-2008: check handling for floats and booleans maybe? - TTypeHandling = (thNone, thDateTime); - - TTypeMapping = record - SchemaName: String; - DelphiName: String; - Handling: TTypeHandling; - end; - - -const - SimpleTypeMapping: array[0..9] of TTypeMapping = - ( - (SchemaName: 'int'; DelphiName: 'Integer'; Handling: thNone), - (SchemaName: 'integer'; DelphiName: 'Integer'; Handling: thNone), - (SchemaName: 'short'; DelphiName: 'Smallint'; Handling: thNone), - (SchemaName: 'date'; DelphiName: 'TDateTime'; Handling: thDateTime), - (SchemaName: 'time'; DelphiName: 'TDateTime'; Handling: thDateTime), - (SchemaName: 'dateTime'; DelphiName: 'TDateTime'; Handling: thDateTime), - (SchemaName: 'float'; DelphiName: 'Double'; Handling: thNone), - (SchemaName: 'double'; DelphiName: 'Extended'; Handling: thNone), - (SchemaName: 'boolean'; DelphiName: 'Boolean'; Handling: thNone), - (SchemaName: 'string'; DelphiName: 'WideString'; Handling: thNone) - ); - { TDelphiXMLDataBindingGenerator } procedure TDelphiXMLDataBindingGenerator.GenerateDataBinding(); @@ -164,15 +89,15 @@ begin unitStream := TStreamHelper.Create(TFileStream.Create(unitName, fmCreate), soOwned); try WriteUnitHeader(unitStream, unitName); - - WriteInterface(unitStream); + + unitStream.Write(UnitInterface); WriteSection(unitStream, dxsForward); FProcessedItems := TX2OIHash.Create(); try FProcessedItems.Clear(); WriteSection(unitStream, dxsInterface); - + FProcessedItems.Clear(); WriteSection(unitStream, dxsClass); finally @@ -182,11 +107,15 @@ begin WriteDocumentFunctions(unitStream, dxsInterface); WriteEnumerationConstants(unitStream); - WriteImplementation(unitStream); + unitStream.Write(UnitImplementation); WriteDocumentFunctions(unitStream, dxsImplementation); + WriteEnumerationConversions(unitStream); + + // #ToDo1 (MvR) 20-3-2008: write conversion methods + WriteSection(unitStream, dxsImplementation); - WriteUnitFooter(unitStream); + unitStream.Write(unitFooter); finally FreeAndNil(unitStream); end; @@ -198,7 +127,7 @@ begin end; -function TDelphiXMLDataBindingGenerator.TranslateDataType(ADataType: IXMLTypeDef): String; +function TDelphiXMLDataBindingGenerator.GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean; var mappingIndex: Integer; dataTypeName: string; @@ -206,7 +135,7 @@ var begin Assert(not ADataType.IsComplex, 'Complex DataTypes not supported'); Assert(ADataType.Enumerations.Count = 0, 'Enumerations not supported'); - Result := 'Variant'; + Result := False; if (ADataType.NamespaceURI = SXMLSchemaURI_1999) or (ADataType.NamespaceURI = SXMLSchemaURI_2000_10) or @@ -217,13 +146,22 @@ begin for mappingIndex := Low(SimpleTypeMapping) to High(SimpleTypeMapping) do if SimpleTypeMapping[mappingIndex].SchemaName = dataTypeName then begin - Result := SimpleTypeMapping[mappingIndex].DelphiName; + ATypeMapping := SimpleTypeMapping[mappingIndex]; + Result := True; Break; end; end; +end; -// if Result = 'Variant' then -// ShowMessage('Unknown type: ' + ADataType.Name); + +function TDelphiXMLDataBindingGenerator.TranslateDataType(ADataType: IXMLTypeDef): String; +var + typeMapping: TTypeMapping; + +begin + Result := 'Variant'; + if GetDataTypeMapping(ADataType, typeMapping) then + Result := typeMapping.DelphiName; end; @@ -259,39 +197,9 @@ end; procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; const AFileName: String); begin // #ToDo3 (MvR) 14-4-2007: if outputtype = multiple, use include files - - AStream.WriteLn('{'); - AStream.WriteLn(' X2Software XML Data Binding Wizard'); - AStream.WriteLn(' Generated from: ' + SourceFileName); - AStream.WriteLn('}'); - AStream.WriteLn('unit ' + ChangeFileExt(ExtractFileName(AFileName), '') + ';'); - AStream.WriteLn(); -end; - - -procedure TDelphiXMLDataBindingGenerator.WriteInterface(AStream: TStreamHelper); -begin - AStream.WriteLn('interface'); - AStream.WriteLn('uses'); - AStream.WriteLn(' Classes,'); - AStream.WriteLn(' XMLDoc,'); - AStream.WriteLn(' XMLIntf;'); - AStream.WriteLn(); - AStream.WriteLn('type'); -end; - - -procedure TDelphiXMLDataBindingGenerator.WriteImplementation(AStream: TStreamHelper); -begin - AStream.WriteLn('implementation'); - AStream.WriteLn(); -end; - - -procedure TDelphiXMLDataBindingGenerator.WriteUnitFooter(AStream: TStreamHelper); -begin - AStream.WriteLn(); - AStream.WriteLn('end.'); + AStream.WriteNamedFmt(UnitHeader, + ['SourceFileName', SourceFileName, + 'UnitName', ChangeFileExt(ExtractFileName(AFileName), '')]); end; @@ -324,7 +232,6 @@ var item: TXMLDataBindingItem; interfaceItem: TXMLDataBindingInterface; hasItem: Boolean; - docBinding: String; begin hasItem := False; @@ -352,55 +259,15 @@ begin hasItem := True; end; - docBinding := NamedFormat('GetDocBinding(''%:s'', TXML%:s, TargetNamespace) as IXML%:s', - ['SourceName', interfaceItem.Name, - 'Name', interfaceItem.TranslatedName]); - - with TNamedFormatStringList.Create() do try case ASection of - dxsInterface: - begin - Add(' function Get%:s(ADocument: IXMLDocument): IXML%:s;'); - Add(' function Load%:s(const AFileName: String): IXML%:s;'); - Add(' function Load%:sFromStream(AStream: TStream): IXML%:s;'); - Add(' function New%:s: IXML%:s;'); - end; - dxsImplementation: - begin - Add('function Get%:s(ADocument: IXMLDocument): IXML%:s;'); - Add('begin'); - Add(' Result := ADocument.' + docBinding); - Add('end;'); - AddLn; - - Add('function Load%:s(const AFileName: String): IXML%:s;'); - Add('begin'); - Add(' Result := LoadXMLDocument(AFileName).' + docBinding); - Add('end;'); - AddLn; - - Add('function Load%:sFromStream(AStream: TStream): IXML%:s;'); - Add('var'); - Add(' doc: IXMLDocument;'); - AddLn; - Add('begin'); - Add(' doc := NewXMLDocument;'); - Add(' doc.LoadFromStream(AStream);'); - Add(' Result := Get%:s(doc);'); - Add('end;'); - AddLn; - - Add('function New%:s: IXML%:s;'); - Add('begin'); - Add(' Result := NewXMLDocument.' + docBinding); - Add('end;'); - AddLn; - end; + dxsInterface: Add(DocumentFunctionsInterface); + dxsImplementation: Add(DocumentFunctionsImplementation); end; - AStream.Write(Format(['Name', interfaceItem.TranslatedName])); + AStream.Write(Format(['SourceName', interfaceItem.Name, + 'Name', interfaceItem.TranslatedName])); finally Free(); end; @@ -427,33 +294,44 @@ var itemIndex: Integer; schema: TXMLDataBindingSchema; schemaIndex: Integer; - hasItem: Boolean; + enumerations: TObjectList; begin { Write array constants for enumerations } - hasItem := False; - - for schemaIndex := 0 to Pred(SchemaCount) do - begin - schema := Schemas[schemaIndex]; - - for itemIndex := 0 to Pred(schema.ItemCount) do + enumerations := TObjectList.Create(False); + try + for schemaIndex := 0 to Pred(SchemaCount) do begin - item := schema.Items[itemIndex]; + schema := Schemas[schemaIndex]; - if item.ItemType = itEnumeration then + for itemIndex := 0 to Pred(schema.ItemCount) do begin - if not hasItem then - AStream.WriteLn('const'); + item := schema.Items[itemIndex]; - WriteSchemaEnumerationArray(AStream, TXMLDataBindingEnumeration(item)); - hasItem := True; + if item.ItemType = itEnumeration then + enumerations.Add(item); end; end; + + if enumerations.Count > 0 then + begin + AStream.WriteLn('const'); + + for itemIndex := 0 to Pred(enumerations.Count) do + WriteSchemaEnumerationArray(AStream, TXMLDataBindingEnumeration(enumerations[itemIndex])); + end; + finally + FreeAndNil(enumerations); end; end; +procedure TDelphiXMLDataBindingGenerator.WriteEnumerationConversions(AStream: TStreamHelper); +begin + // +end; + + procedure TDelphiXMLDataBindingGenerator.WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem); var lines: TStringList; @@ -618,7 +496,6 @@ var writeOptional: Boolean; writeTextProp: Boolean; hasMembers: Boolean; - localHasMembers: Boolean; member: TDelphiXMLMember; value: String; sourceCode: TNamedFormatStringList; @@ -626,18 +503,22 @@ var begin // #ToDo1 (MvR) 9-3-2008: refactor WriteSchemaInterfaceProperties - // #ToDo1 (MvR) 17-3-2008: support conversions! if ASection = dxsForward then Exit; if ASection = dxsImplementation then WriteAfterConstruction(); - hasMembers := False; + if ASection = dxsClass then + AStream.WriteLn(' protected'); + hasMembers := False; for member := Low(TDelphiXMLMember) to High(TDelphiXMLMember) do begin - localHasMembers := False; + if hasMembers then + AStream.WriteLn; + + hasMembers := False; for propertyIndex := 0 to Pred(AItem.PropertyCount) do begin @@ -687,53 +568,51 @@ begin dxsClass: begin { Interface declaration } - if not hasMembers then - begin - if ASection = dxsClass then - AStream.WriteLn(' protected'); - end else if not localHasMembers then - AStream.WriteLn(); - - case member of dxmPropertyGet: begin if writeOptional then - sourceCode.Add(' function GetHas%:s: Boolean;'); + sourceCode.Add(PropertyIntfMethodGetOptional); if writeTextProp then - sourceCode.Add(' function Get%:sText: WideString;'); + sourceCode.Add(PropertyIntfMethodGetText); - sourceCode.Add(' function Get%:s: %:s;'); + sourceCode.Add(PropertyIntfMethodGet); + hasMembers := True; end; dxmPropertySet: if not itemProperty.IsReadOnly then begin if writeTextProp then - sourceCode.Add(' procedure Set%:sText(const Value: WideString);'); + sourceCode.Add(PropertyIntfMethodSetText); - sourceCode.Add(' procedure Set%:s(const Value: %:s);'); + sourceCode.Add(PropertyIntfMethodSet); + hasMembers := True; end; dxmPropertyDeclaration: begin if writeOptional then - sourceCode.Add(' property Has%:s: Boolean read GetHas%:s;'); - - if writeTextProp then - sourceCode.Add(' property %:sText: WideString read Get%:sText;'); + sourceCode.Add(PropertyInterfaceOptional); if itemProperty.IsReadOnly then - sourceCode.Add(' property %:s: %:s read Get%:s;') - else - sourceCode.Add(' property %:s: %:s read Get%:s write Set%:s;'); + 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; - - - hasMembers := True; - localHasMembers := True; end; dxsImplementation: begin @@ -742,34 +621,18 @@ begin dxmPropertyGet: begin if writeOptional then - begin - sourceCode.Add('function TXML%:s.GetHas%:s: Boolean;'); - sourceCode.Add('begin'); - sourceCode.Add(' Result := Assigned(ChildNodes.FindNode(''%:s''));'); - sourceCode.Add('end;'); - sourceCode.AddLn; - end; - + sourceCode.Add(PropertyImplMethodGetOptional); if writeTextProp then - begin - sourceCode.Add('function TXML%:s.Get%:sText: WideString;'); - sourceCode.Add('begin'); - sourceCode.Add(' Result := ChildNodes[''%:s''].NodeValue;'); - sourceCode.Add('end;'); - sourceCode.AddLn; - end; - + sourceCode.Add(PropertyImplMethodGetText); sourceCode.Add('function TXML%:s.Get%:s: %:s;'); case itemProperty.PropertyType of ptSimple: - begin - sourceCode.Add('begin'); - sourceCode.Add(' Result := ChildNodes[''%:s''].NodeValue;'); - sourceCode.Add('end;'); - end; + sourceCode.Add(XMLToNativeDataType('Result', + 'ChildNodes[''%:s''].NodeValue', + TXMLDataBindingSimpleProperty(itemProperty).DataType)); ptItem: begin @@ -799,6 +662,7 @@ begin sourceCode.Add(' Result := enumValue;'); sourceCode.Add(' break;'); sourceCode.Add(' end;'); + sourceCode.Add('end;'); end; end; end; @@ -811,24 +675,25 @@ begin if not itemProperty.IsReadOnly then begin if writeTextProp then - begin - sourceCode.Add('procedure TXML%:s.Set%:sText(const Value: WideString);'); - sourceCode.Add('begin'); - sourceCode.Add(' ChildNodes[''%:s''].NodeValue := Value;'); - sourceCode.Add('end;'); - sourceCode.AddLn; - end; - - if Assigned(propertyItem) and (propertyItem.ItemType = itEnumeration) then - value := '%:sValues[Value]' - else - value := 'Value'; + sourceCode.Add(PropertyImplMethodSetText); sourceCode.Add('procedure TXML%:s.Set%:s(const Value: %:s);'); - sourceCode.Add('begin'); - sourceCode.Add(' ChildNodes[''%:s''].NodeValue := ' + value + ';'); - sourceCode.Add('end;'); - sourceCode.AddLn; + 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; @@ -900,22 +765,26 @@ procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollectionProperties(AStream var dataIntfName: string; dataTypeName: string; + dataClassName: string; sourceCode: TNamedFormatStringList; + typeDef: IXMLTypeDef; begin if ASection = dxsClass then AStream.WriteLn(' protected'); - // #ToDo1 (MvR) 17-3-2008: DataType for enumerations etc. + // #ToDo1 (MvR) 17-3-2008: DataType for enumerations case AItem.CollectionItem.PropertyType of ptSimple: begin - dataTypeName := AItem.CollectionItem.TranslatedName; + dataTypeName := TranslateDataType(TXMLDataBindingSimpleProperty(AItem.CollectionItem).DataType); + dataClassName := 'TXMLNode'; dataIntfName := 'IXMLNode'; end; ptItem: begin dataTypeName := PrefixInterface + AItem.CollectionItem.TranslatedName; + dataClassName := PrefixClass + AItem.CollectionItem.TranslatedName; dataIntfName := dataTypeName; end; end; @@ -927,17 +796,26 @@ begin dxsClass: begin sourceCode.Add(' function Get_%:s(Index: Integer): %:s;'); - sourceCode.Add(' function Add: %:s;'); - sourceCode.Add(' function Insert(Index: Integer): %:s;'); + + case AItem.CollectionItem.PropertyType of + ptSimple: + begin + sourceCode.Add(' function Add(%:s: %:s): %:s;'); + sourceCode.Add(' function Insert(Index: Integer; %:s: %:s): %:s;'); + end; + + ptItem: + begin + sourceCode.Add(' function Add: %:s;'); + sourceCode.Add(' function Insert(Index: Integer): %:s;'); + end; + end; end; dxsImplementation: begin sourceCode.Add('procedure TXML%:s.AfterConstruction;'); sourceCode.Add('begin'); - - // #ToDo1 (MvR) 17-3-2008: DataType class / interface!! - sourceCode.Add(' RegisterChildNode(''%:s'', %:s);'); - + sourceCode.Add(' RegisterChildNode(''%:s'', %:s);'); sourceCode.AddLn; sourceCode.Add(' ItemTag := ''%:s'';'); sourceCode.Add(' ItemInterface := %:s;'); @@ -946,23 +824,50 @@ begin sourceCode.Add('end;'); sourceCode.AddLn; - sourceCode.Add('function TXML%:s.Get_%:s(Index: Integer): %:s;'); - sourceCode.Add('begin'); - sourceCode.Add(' Result := (List[Index] as %:s;'); - sourceCode.Add('end;'); - sourceCode.AddLn; - sourceCode.Add('function TXML%:s.Add(Index: Integer): %:s;'); - sourceCode.Add('begin'); - sourceCode.Add(' Result := (AddItem(-1) as %:s;'); - sourceCode.Add('end;'); - sourceCode.AddLn; + case AItem.CollectionItem.PropertyType of + ptSimple: + begin + typeDef := TXMLDataBindingSimpleProperty(AItem.CollectionItem).DataType; - sourceCode.Add('function TXML%:s.Insert(Index: Integer): %:s;'); - sourceCode.Add('begin'); - sourceCode.Add(' Result := (AddItem(Index) as %:s;'); - sourceCode.Add('end;'); - sourceCode.AddLn; + // #ToDo1 (MvR) 19-3-2008: .Text for strings ? + sourceCode.Add('function TXML%:s.Get_%:s(Index: Integer): %:s;'); + sourceCode.Add(XMLToNativeDataType('Result', 'List[Index].NodeValue', typeDef)); + sourceCode.AddLn; + + sourceCode.Add('function TXML%:s.Add(%:s: %:s): %:s;'); + sourceCode.Add(NativeDataTypeToXML('Result.NodeValue', '%:s', typeDef, + ' Result := AddItem(-1);')); + sourceCode.AddLn; + + sourceCode.Add('function TXML%:s.Insert(Index: Integer; %:s: %:s): %:s;'); + sourceCode.Add(NativeDataTypeToXML('Result.NodeValue', '%:s', typeDef, + ' Result := AddItem(Index);')); + sourceCode.AddLn; + end; + + + ptItem: + begin + sourceCode.Add('function TXML%:s.Get_%:s(Index: Integer): %:s;'); + sourceCode.Add('begin'); + sourceCode.Add(' Result := (List[Index] as %:s);'); + sourceCode.Add('end;'); + sourceCode.AddLn; + + sourceCode.Add('function TXML%:s.Add: %:s;'); + sourceCode.Add('begin'); + sourceCode.Add(' Result := (AddItem(-1) as %:s);'); + sourceCode.Add('end;'); + sourceCode.AddLn; + + sourceCode.Add('function TXML%:s.Insert(Index: Integer): %:s;'); + sourceCode.Add('begin'); + sourceCode.Add(' Result := (AddItem(Index) as %:s);'); + sourceCode.Add('end;'); + sourceCode.AddLn; + end; + end; end; end; @@ -984,6 +889,7 @@ begin 'ItemName', AItem.CollectionItem.TranslatedName, 'ItemSourceName', AItem.CollectionItem.Name, 'DataType', dataTypeName, + 'DataClass', dataClassName, 'DataInterface', dataIntfName])); finally FreeAndNil(sourceCode); @@ -1056,6 +962,55 @@ begin end; +function TDelphiXMLDataBindingGenerator.DataTypeConversion(const ADestination, ASource: string; ADataType: IXMLTypeDef; AToNative: Boolean; const ALinesBefore: string): string; +var + typeMapping: TTypeMapping; + +begin + with TNamedFormatStringList.Create() do + try + if not GetDataTypeMapping(ADataType, typeMapping) then + typeMapping.Conversion := tcNone; + + + if Length(TypeConversionVariables[typeMapping.Conversion]) > 0 then + begin + Add('var'); + Add(TypeConversionVariables[typeMapping.Conversion]); + end; + + Add('begin'); + + if Length(ALinesBefore) > 0 then + Add(ALinesBefore); + + if AToNative then + Add(TypeConversionToNative[typeMapping.Conversion]) + else + Add(TypeConversionToXML[typeMapping.Conversion]); + + Add('end;'); + + Result := Format(['Destination', ADestination, + 'Source', ASource]); + finally + Free(); + end; +end; + + +function TDelphiXMLDataBindingGenerator.XMLToNativeDataType(const ADestination, ASource: string; ADataType: IXMLTypeDef; const ALinesBefore: string): string; +begin + Result := DataTypeConversion(ADestination, ASource, ADataType, True, ALinesBefore); +end; + + +function TDelphiXMLDataBindingGenerator.NativeDataTypeToXML(const ADestination, ASource: string; ADataType: IXMLTypeDef; const ALinesBefore: string): string; +begin + Result := DataTypeConversion(ADestination, ASource, ADataType, False, ALinesBefore); +end; + + function TDelphiXMLDataBindingGenerator.CreateNewGUID(): String; var guid: TGUID; diff --git a/Units/DelphiXMLDataBindingResources.pas b/Units/DelphiXMLDataBindingResources.pas new file mode 100644 index 0000000..fb63b3f --- /dev/null +++ b/Units/DelphiXMLDataBindingResources.pas @@ -0,0 +1,213 @@ +unit DelphiXMLDataBindingResources; + +interface +type + TDelphiXMLSection = (dxsForward, dxsInterface, dxsClass, dxsImplementation); + TDelphiXMLMember = (dxmPropertyGet, dxmPropertySet, dxmPropertyDeclaration); + + +const + CrLf = #13#10; + + UnitHeader = '{' + CrLf + + ' X2Software XML Data Binding Wizard' + CrLf + + ' Generated from: %:s' + CrLf + + '}' + CrLf + + 'unit %:s;' + CrLf + + '' + CrLf; + + UnitInterface = 'interface' + CrLf + + 'uses' + CrLf + + ' Classes,' + CrLf + + ' XMLDoc,' + CrLf + + ' XMLIntf;' + CrLf + + '' + CrLf + + 'type' + CrLf; + + UnitImplementation = 'implementation' + CrLf + + '' + CrLf; + + UnitFooter = '' + CrLf + + 'end.' + CrLf; + + + + DocumentBinding = 'GetDocBinding(''%:s'', TXML%:s, TargetNamespace) as IXML%:s'; + + DocumentFunctionsInterface = ' function Get%:s(ADocument: IXMLDocument): IXML%:s;' + CrLf + + ' function Load%:s(const AFileName: String): IXML%:s;' + CrLf + + ' function Load%:sFromStream(AStream: TStream): IXML%:s;' + CrLf + + ' function New%:s: IXML%:s;' + CrLf; + + DocumentFunctionsImplementation = 'function Get%:s(ADocument: IXMLDocument): IXML%:s;' + CrLf + + 'begin' + CrLf + + ' Result := ADocument.' + DocumentBinding + CrLf + + 'end;' + CrLf + + '' + CrLf + + 'function Load%:s(const AFileName: String): IXML%:s;' + CrLf + + 'begin' + CrLf + + ' Result := LoadXMLDocument(AFileName).' + DocumentBinding + CrLf + + 'end;' + CrLf + + '' + CrLf + + 'function Load%:sFromStream(AStream: TStream): IXML%:s;' + CrLf + + 'var' + CrLf + + ' doc: IXMLDocument;' + CrLf + + '' + CrLf + + 'begin' + CrLf + + ' doc := NewXMLDocument;' + CrLf + + ' doc.LoadFromStream(AStream);' + CrLf + + ' Result := Get%:s(doc);' + CrLf + + 'end;' + CrLf + + '' + CrLf + + 'function New%:s: IXML%:s;' + CrLf + + 'begin' + CrLf + + ' Result := NewXMLDocument.' + DocumentBinding + CrLf + + 'end;' + CrLf + + '' + CrLf; + + + PropertyIntfMethodGetOptional = ' function GetHas%:s: Boolean;'; + PropertyIntfMethodGetText = ' function Get%:sText: WideString;'; + PropertyIntfMethodGet = ' function Get%:s: %:s;'; + PropertyIntfMethodSetText = ' procedure Set%:sText(const Value: WideString);'; + PropertyIntfMethodSet = ' procedure Set%:s(const Value: %:s);'; + + PropertyInterfaceOptional = ' property Has%:s: Boolean read GetHas%:s;'; + PropertyInterfaceTextReadOnly = ' property %:sText: WideString read Get%:sText;'; + PropertyInterfaceReadOnly = ' property %:s: %:s read Get%:s;'; + PropertyInterfaceText = ' property %:sText: WideString read Get%:sText write Set%:sText;'; + PropertyInterface = ' property %:s: %:s read Get%:s write Set%:s;'; + + PropertyImplMethodGetOptional = 'function TXML%:s.GetHas%:s: Boolean;' + CrLf + + 'begin' + CrLf + + ' Result := Assigned(ChildNodes.FindNode(''%:s''));' + CrLf + + 'end;' + CrLf + + '' + CrLf; + + PropertyImplMethodGetText = 'function TXML%:s.Get%:sText: WideString;' + CrLf + + 'begin' + CrLf + + ' Result := ChildNodes[''%:s''].NodeValue;' + CrLf + + 'end;' + CrLf + + '' + CrLf; + + PropertyImplMethodSetText = 'procedure TXML%:s.Set%:sText(const Value: WideString);' + CrLf + + 'begin' + CrLf + + ' ChildNodes[''%:s''].NodeValue := Value;' + CrLf + + 'end;' + CrLf + + '' + CrLf; + + + SectionComments: array[TDelphiXMLSection] of String = + ( + ' { Forward declarations for %:s }', + ' { Interfaces for %:s }', + ' { Classes for %:s }', + '{ Implementation for %:s }' + ); + + + + + PrefixInterface = 'IXML'; + PrefixClass = 'TXML'; + + + InterfaceItemForward = ' IXML%:s = interface;'; + InterfaceItemInterface = ' IXML%:s = interface(%:s)'; + InterfaceItemClass = ' TXML%:s = class(%:s, IXML%:s)'; + + + CollectionInterface = 'IXMLNodeCollection'; + CollectionClass = 'TXMLNodeCollection'; + + ItemInterface = 'IXMLNode'; + ItemClass = 'TXMLNode'; + + + + // #ToDo1 (MvR) 9-3-2008: document / node / etc + // #ToDo1 (MvR) 9-3-2008: WideString etc ? + ReservedWords: array[0..111] of String = + ( + 'absolute', 'abstract', 'and', 'array', 'as', 'asm', + 'assembler', 'automated', 'begin', 'case', 'cdecl', 'class', + 'const', 'constructor', 'contains', 'default', 'deprecated', + 'destructor', 'dispid', 'dispinterface', 'div', 'do', + 'downto', 'dynamic', 'else', 'end', 'except', 'export', + 'exports', 'external', 'far', 'file', 'final', 'finalization', + 'finally', 'for', 'forward', 'function', 'goto', 'if', + 'implementation', 'implements', 'in', 'index', 'inherited', + 'initialization', 'inline', 'interface', 'is', 'label', + 'library', 'local', 'message', 'mod', 'name', 'near', + 'nil', 'nodefault', 'not', 'object', 'of', 'or', 'out', + 'overload', 'override', 'package', 'packed', 'pascal', + 'platform', 'private', 'procedure', 'program', 'property', + 'protected', 'public', 'published', 'raise', 'read', + 'readonly', 'record', 'register', 'reintroduce', 'repeat', + 'requires', 'resident', 'resourcestring', 'safecall', + 'sealed', 'set', 'shl', 'shr', 'static', 'stdcall', + 'stored', 'string', 'then', 'threadvar', 'to', 'try', 'type', + 'unit', 'unsafe', 'until', 'uses', 'var', 'varargs', + 'virtual', 'while', 'with', 'write', 'writeonly', 'xor' + ); + + +type + TTypeConversion = (tcNone, tcBoolean, tcFloat, tcDateTime); + TTypeConversions = set of TTypeConversion; + + TTypeMapping = record + SchemaName: String; + DelphiName: String; + Conversion: TTypeConversion; + end; + + +const + SimpleTypeMapping: array[0..9] of TTypeMapping = + ( + (SchemaName: 'int'; DelphiName: 'Integer'; Conversion: tcNone), + (SchemaName: 'integer'; DelphiName: 'Integer'; Conversion: tcNone), + (SchemaName: 'short'; DelphiName: 'Smallint'; Conversion: tcNone), + (SchemaName: 'date'; DelphiName: 'TDateTime'; Conversion: tcDateTime), + (SchemaName: 'time'; DelphiName: 'TDateTime'; Conversion: tcDateTime), + (SchemaName: 'dateTime'; DelphiName: 'TDateTime'; Conversion: tcDateTime), + (SchemaName: 'float'; DelphiName: 'Double'; Conversion: tcFloat), + (SchemaName: 'double'; DelphiName: 'Double'; Conversion: tcFloat), + (SchemaName: 'boolean'; DelphiName: 'Boolean'; Conversion: tcBoolean), + (SchemaName: 'string'; DelphiName: 'WideString'; Conversion: tcNone) + ); + + + + TypeConversionNone = ' %:s := %:s;'; + + + TypeConversionVariables: array[TTypeConversion] of String = + ( + { tcNone } '', + { tcBoolean } '', + { tcFloat } '', + { tcDateTime } '' + ); + + TypeConversionToNative: array[TTypeConversion] of String = + ( + { tcNone } TypeConversionNone, + { tcBoolean } TypeConversionNone, + { tcFloat } TypeConversionNone, + { tcDateTime } TypeConversionNone + ); + + TypeConversionToXML: array[TTypeConversion] of String = + ( + { tcNone } TypeConversionNone, + { tcBoolean } ' %:s := LowerCase(BoolToStr(%:s, True));', + { tcFloat } TypeConversionNone, + { tcDateTime } TypeConversionNone + ); + + +implementation +end. + diff --git a/Units/XMLDataBindingGenerator.pas b/Units/XMLDataBindingGenerator.pas index 08e3025..fcfdcb5 100644 --- a/Units/XMLDataBindingGenerator.pas +++ b/Units/XMLDataBindingGenerator.pas @@ -2,7 +2,7 @@ unit XMLDataBindingGenerator; // #ToDo1 (MvR) 7-3-2008: check if List items can be collapsed if an item is // already a list parent -// #ToDo3 (MvR) 7-3-2008: enum collections? +// #ToDo1 (MvR) 19-3-2008: attributes interface uses Classes, @@ -344,6 +344,11 @@ begin for schemaIndex := 0 to Pred(SchemaCount) do ResolveSchema(Schemas[schemaIndex]); + + { Collapse collections } + + + { Resolve naming conflicts } ResolveNameConflicts(); @@ -592,7 +597,6 @@ begin interfaceObject.BaseName := AElement.DataType.BaseTypeName; ASchema.AddItem(interfaceObject); - Result := interfaceObject; end; diff --git a/X2XMLDataBindingCmdLine.dof b/X2XMLDataBindingCmdLine.dof index 1cba0b7..3468bb5 100644 --- a/X2XMLDataBindingCmdLine.dof +++ b/X2XMLDataBindingCmdLine.dof @@ -100,7 +100,7 @@ Conditionals= DebugSourceDirs= UsePackages=0 [Parameters] -RunParams="p:\test\XMLDataBinding\Tests\Data\02. Collection.xsd" "P:\xtx\xtx\xsd\xml_Offerte.pas" +RunParams="P:\xtx\xtx\xsd\Offerte.xsd" "P:\xtx\xtx\xsd\xml_Offerte.pas" HostApplication= Launcher= UseLauncher=0 diff --git a/X2XMLDataBindingCmdLine.dpr b/X2XMLDataBindingCmdLine.dpr index 4e84c45..7cbf30b 100644 --- a/X2XMLDataBindingCmdLine.dpr +++ b/X2XMLDataBindingCmdLine.dpr @@ -5,7 +5,8 @@ uses SysUtils, DelphiXMLDataBindingGenerator in 'Units\DelphiXMLDataBindingGenerator.pas', XMLDataBindingGenerator in 'Units\XMLDataBindingGenerator.pas', - XMLDataBindingHelpers in 'Units\XMLDataBindingHelpers.pas'; + XMLDataBindingHelpers in 'Units\XMLDataBindingHelpers.pas', + DelphiXMLDataBindingResources in 'Units\DelphiXMLDataBindingResources.pas'; begin CoInitialize(nil);