GitHub-Mirror/x2xmldatabinding
1
0
Fork 0
mirror of synced 2024-11-21 21:43:49 +00:00
Code Issues Projects Releases Wiki Activity

Added: better support for datatype conversions

Browse Source 
Changed: extracted most strings to the Resources unit
This commit is contained in:
Mark van Renswoude 2008-03-21 15:23:14 +00:00
parent 372812b547
commit 107589b839
5 changed files with 454 additions and 281 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

453
Units/DelphiXMLDataBindingGenerator.pas
View File

@ -7,14 +7,14 @@ uses
X2UtHashes, X2UtHashes,
DelphiXMLDataBindingResources,
XMLDataBindingGenerator, XMLDataBindingGenerator,
XMLDataBindingHelpers; XMLDataBindingHelpers;
type type
TGetFileNameEvent = procedure(Sender: TObject; const SchemaName: String; var Result: String) of object; TGetFileNameEvent = procedure(Sender: TObject; const SchemaName: String; var Result: String) of object;
TDelphiXMLSection = (dxsForward, dxsInterface, dxsClass, dxsImplementation);
TDelphiXMLMember = (dxmPropertyGet, dxmPropertySet, dxmPropertyDeclaration);
TDelphiXMLDataBindingGenerator = class(TXMLDataBindingGenerator) TDelphiXMLDataBindingGenerator = class(TXMLDataBindingGenerator)
private private
@ -31,16 +31,15 @@ type
function DoGetFileName(const ASchemaName: String): String; function DoGetFileName(const ASchemaName: String): String;
function GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean;
function TranslateDataType(ADataType: IXMLTypeDef): String; function TranslateDataType(ADataType: IXMLTypeDef): String;
function CreateNewGUID(): String; function CreateNewGUID(): String;
procedure WriteUnitHeader(AStream: TStreamHelper; const AFileName: 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 WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection);
procedure WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection); procedure WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection);
procedure WriteEnumerationConstants(AStream: TStreamHelper); procedure WriteEnumerationConstants(AStream: TStreamHelper);
procedure WriteEnumerationConversions(AStream: TStreamHelper);
procedure WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem); procedure WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem);
procedure WriteSchemaItem(AStream: TStreamHelper; AItem: TXMLDataBindingItem; ASection: TDelphiXMLSection); procedure WriteSchemaItem(AStream: TStreamHelper; AItem: TXMLDataBindingItem; ASection: TDelphiXMLSection);
@ -51,98 +50,24 @@ type
procedure WriteSchemaEnumeration(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration; ASection: TDelphiXMLSection); procedure WriteSchemaEnumeration(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration; ASection: TDelphiXMLSection);
procedure WriteSchemaEnumerationArray(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration); 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; property ProcessedItems: TX2OIHash read FProcessedItems;
public public
property OnGetFileName: TGetFileNameEvent read FOnGetFileName write FOnGetFileName; property OnGetFileName: TGetFileNameEvent read FOnGetFileName write FOnGetFileName;
end; end;
implementation implementation
uses uses
Contnrs,
SysUtils, SysUtils,
X2UtNamedFormat; X2UtNamedFormat;
const
SectionComments: array[TDelphiXMLSection] of String =
(
' { Forward declarations for %<SchemaName>:s }',
' { Interfaces for %<SchemaName>:s }',
' { Classes for %<SchemaName>:s }',
'{ Implementation for %<SchemaName>:s }'
);
PrefixInterface = 'IXML';
PrefixClass = 'TXML';
InterfaceItemForward = ' IXML%<Name>:s = interface;';
InterfaceItemInterface = ' IXML%<Name>:s = interface(%<ParentName>:s)';
InterfaceItemClass = ' TXML%<Name>:s = class(%<ParentName>:s, IXML%<Name>: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 } { TDelphiXMLDataBindingGenerator }
procedure TDelphiXMLDataBindingGenerator.GenerateDataBinding(); procedure TDelphiXMLDataBindingGenerator.GenerateDataBinding();
@ -165,7 +90,7 @@ begin
try try
WriteUnitHeader(unitStream, unitName); WriteUnitHeader(unitStream, unitName);
WriteInterface(unitStream); unitStream.Write(UnitInterface);
WriteSection(unitStream, dxsForward); WriteSection(unitStream, dxsForward);
FProcessedItems := TX2OIHash.Create(); FProcessedItems := TX2OIHash.Create();
@ -182,11 +107,15 @@ begin
WriteDocumentFunctions(unitStream, dxsInterface); WriteDocumentFunctions(unitStream, dxsInterface);
WriteEnumerationConstants(unitStream); WriteEnumerationConstants(unitStream);
WriteImplementation(unitStream); unitStream.Write(UnitImplementation);
WriteDocumentFunctions(unitStream, dxsImplementation); WriteDocumentFunctions(unitStream, dxsImplementation);
WriteEnumerationConversions(unitStream);
// #ToDo1 (MvR) 20-3-2008: write conversion methods
WriteSection(unitStream, dxsImplementation); WriteSection(unitStream, dxsImplementation);
WriteUnitFooter(unitStream); unitStream.Write(unitFooter);
finally finally
FreeAndNil(unitStream); FreeAndNil(unitStream);
end; end;
@ -198,7 +127,7 @@ begin
end; end;
function TDelphiXMLDataBindingGenerator.TranslateDataType(ADataType: IXMLTypeDef): String; function TDelphiXMLDataBindingGenerator.GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean;
var var
mappingIndex: Integer; mappingIndex: Integer;
dataTypeName: string; dataTypeName: string;
@ -206,7 +135,7 @@ var
begin begin
Assert(not ADataType.IsComplex, 'Complex DataTypes not supported'); Assert(not ADataType.IsComplex, 'Complex DataTypes not supported');
Assert(ADataType.Enumerations.Count = 0, 'Enumerations not supported'); Assert(ADataType.Enumerations.Count = 0, 'Enumerations not supported');
Result := 'Variant'; Result := False;
if (ADataType.NamespaceURI = SXMLSchemaURI_1999) or if (ADataType.NamespaceURI = SXMLSchemaURI_1999) or
(ADataType.NamespaceURI = SXMLSchemaURI_2000_10) or (ADataType.NamespaceURI = SXMLSchemaURI_2000_10) or
@ -217,13 +146,22 @@ begin
for mappingIndex := Low(SimpleTypeMapping) to High(SimpleTypeMapping) do for mappingIndex := Low(SimpleTypeMapping) to High(SimpleTypeMapping) do
if SimpleTypeMapping[mappingIndex].SchemaName = dataTypeName then if SimpleTypeMapping[mappingIndex].SchemaName = dataTypeName then
begin begin
Result := SimpleTypeMapping[mappingIndex].DelphiName; ATypeMapping := SimpleTypeMapping[mappingIndex];
Result := True;
Break; Break;
end; end;
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; end;
@ -259,39 +197,9 @@ end;
procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; const AFileName: String); procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; const AFileName: String);
begin begin
// #ToDo3 (MvR) 14-4-2007: if outputtype = multiple, use include files // #ToDo3 (MvR) 14-4-2007: if outputtype = multiple, use include files
AStream.WriteNamedFmt(UnitHeader,
AStream.WriteLn('{'); ['SourceFileName', SourceFileName,
AStream.WriteLn(' X2Software XML Data Binding Wizard'); 'UnitName', ChangeFileExt(ExtractFileName(AFileName), '')]);
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.');
end; end;
@ -324,7 +232,6 @@ var
item: TXMLDataBindingItem; item: TXMLDataBindingItem;
interfaceItem: TXMLDataBindingInterface; interfaceItem: TXMLDataBindingInterface;
hasItem: Boolean; hasItem: Boolean;
docBinding: String;
begin begin
hasItem := False; hasItem := False;
@ -352,55 +259,15 @@ begin
hasItem := True; hasItem := True;
end; end;
docBinding := NamedFormat('GetDocBinding(''%<SourceName>:s'', TXML%<Name>:s, TargetNamespace) as IXML%<Name>:s',
['SourceName', interfaceItem.Name,
'Name', interfaceItem.TranslatedName]);
with TNamedFormatStringList.Create() do with TNamedFormatStringList.Create() do
try try
case ASection of case ASection of
dxsInterface: dxsInterface: Add(DocumentFunctionsInterface);
begin dxsImplementation: Add(DocumentFunctionsImplementation);
Add(' function Get%<Name>:s(ADocument: IXMLDocument): IXML%<Name>:s;');
Add(' function Load%<Name>:s(const AFileName: String): IXML%<Name>:s;');
Add(' function Load%<Name>:sFromStream(AStream: TStream): IXML%<Name>:s;');
Add(' function New%<Name>:s: IXML%<Name>:s;');
end;
dxsImplementation:
begin
Add('function Get%<Name>:s(ADocument: IXMLDocument): IXML%<Name>:s;');
Add('begin');
Add(' Result := ADocument.' + docBinding);
Add('end;');
AddLn;
Add('function Load%<Name>:s(const AFileName: String): IXML%<Name>:s;');
Add('begin');
Add(' Result := LoadXMLDocument(AFileName).' + docBinding);
Add('end;');
AddLn;
Add('function Load%<Name>:sFromStream(AStream: TStream): IXML%<Name>:s;');
Add('var');
Add(' doc: IXMLDocument;');
AddLn;
Add('begin');
Add(' doc := NewXMLDocument;');
Add(' doc.LoadFromStream(AStream);');
Add(' Result := Get%<Name>:s(doc);');
Add('end;');
AddLn;
Add('function New%<Name>:s: IXML%<Name>:s;');
Add('begin');
Add(' Result := NewXMLDocument.' + docBinding);
Add('end;');
AddLn;
end;
end; end;
AStream.Write(Format(['Name', interfaceItem.TranslatedName])); AStream.Write(Format(['SourceName', interfaceItem.Name,
'Name', interfaceItem.TranslatedName]));
finally finally
Free(); Free();
end; end;
@ -427,12 +294,12 @@ var
itemIndex: Integer; itemIndex: Integer;
schema: TXMLDataBindingSchema; schema: TXMLDataBindingSchema;
schemaIndex: Integer; schemaIndex: Integer;
hasItem: Boolean; enumerations: TObjectList;
begin begin
{ Write array constants for enumerations } { Write array constants for enumerations }
hasItem := False; enumerations := TObjectList.Create(False);
try
for schemaIndex := 0 to Pred(SchemaCount) do for schemaIndex := 0 to Pred(SchemaCount) do
begin begin
schema := Schemas[schemaIndex]; schema := Schemas[schemaIndex];
@ -442,18 +309,29 @@ begin
item := schema.Items[itemIndex]; item := schema.Items[itemIndex];
if item.ItemType = itEnumeration then if item.ItemType = itEnumeration then
enumerations.Add(item);
end;
end;
if enumerations.Count > 0 then
begin begin
if not hasItem then
AStream.WriteLn('const'); AStream.WriteLn('const');
WriteSchemaEnumerationArray(AStream, TXMLDataBindingEnumeration(item)); for itemIndex := 0 to Pred(enumerations.Count) do
hasItem := True; WriteSchemaEnumerationArray(AStream, TXMLDataBindingEnumeration(enumerations[itemIndex]));
end;
end; end;
finally
FreeAndNil(enumerations);
end; end;
end; end;
procedure TDelphiXMLDataBindingGenerator.WriteEnumerationConversions(AStream: TStreamHelper);
begin
//
end;
procedure TDelphiXMLDataBindingGenerator.WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem); procedure TDelphiXMLDataBindingGenerator.WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem);
var var
lines: TStringList; lines: TStringList;
@ -618,7 +496,6 @@ var
writeOptional: Boolean; writeOptional: Boolean;
writeTextProp: Boolean; writeTextProp: Boolean;
hasMembers: Boolean; hasMembers: Boolean;
localHasMembers: Boolean;
member: TDelphiXMLMember; member: TDelphiXMLMember;
value: String; value: String;
sourceCode: TNamedFormatStringList; sourceCode: TNamedFormatStringList;
@ -626,18 +503,22 @@ var
begin begin
// #ToDo1 (MvR) 9-3-2008: refactor WriteSchemaInterfaceProperties // #ToDo1 (MvR) 9-3-2008: refactor WriteSchemaInterfaceProperties
// #ToDo1 (MvR) 17-3-2008: support conversions!
if ASection = dxsForward then if ASection = dxsForward then
Exit; Exit;
if ASection = dxsImplementation then if ASection = dxsImplementation then
WriteAfterConstruction(); WriteAfterConstruction();
hasMembers := False; if ASection = dxsClass then
AStream.WriteLn(' protected');
hasMembers := False;
for member := Low(TDelphiXMLMember) to High(TDelphiXMLMember) do for member := Low(TDelphiXMLMember) to High(TDelphiXMLMember) do
begin begin
localHasMembers := False; if hasMembers then
AStream.WriteLn;
hasMembers := False;
for propertyIndex := 0 to Pred(AItem.PropertyCount) do for propertyIndex := 0 to Pred(AItem.PropertyCount) do
begin begin
@ -687,53 +568,51 @@ begin
dxsClass: dxsClass:
begin begin
{ Interface declaration } { 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 case member of
dxmPropertyGet: dxmPropertyGet:
begin begin
if writeOptional then if writeOptional then
sourceCode.Add(' function GetHas%<PropertyName>:s: Boolean;'); sourceCode.Add(PropertyIntfMethodGetOptional);
if writeTextProp then if writeTextProp then
sourceCode.Add(' function Get%<PropertyName>:sText: WideString;'); sourceCode.Add(PropertyIntfMethodGetText);
sourceCode.Add(' function Get%<PropertyName>:s: %<DataType>:s;'); sourceCode.Add(PropertyIntfMethodGet);
hasMembers := True;
end; end;
dxmPropertySet: dxmPropertySet:
if not itemProperty.IsReadOnly then if not itemProperty.IsReadOnly then
begin begin
if writeTextProp then if writeTextProp then
sourceCode.Add(' procedure Set%<PropertyName>:sText(const Value: WideString);'); sourceCode.Add(PropertyIntfMethodSetText);
sourceCode.Add(' procedure Set%<PropertyName>:s(const Value: %<DataType>:s);'); sourceCode.Add(PropertyIntfMethodSet);
hasMembers := True;
end; end;
dxmPropertyDeclaration: dxmPropertyDeclaration:
begin begin
if writeOptional then if writeOptional then
sourceCode.Add(' property Has%<PropertyName>:s: Boolean read GetHas%<PropertyName>:s;'); sourceCode.Add(PropertyInterfaceOptional);
if writeTextProp then
sourceCode.Add(' property %<PropertyName>:sText: WideString read Get%<PropertyName>:sText;');
if itemProperty.IsReadOnly then if itemProperty.IsReadOnly then
sourceCode.Add(' property %<PropertyName>:s: %<DataType>:s read Get%<PropertyName>:s;') begin
else if writeTextProp then
sourceCode.Add(' property %<PropertyName>:s: %<DataType>:s read Get%<PropertyName>:s write Set%<PropertyName>:s;'); sourceCode.Add(PropertyInterfaceTextReadOnly);
end;
end;
sourceCode.Add(PropertyInterfaceReadOnly);
end else
begin
if writeTextProp then
sourceCode.Add(PropertyInterfaceText);
sourceCode.Add(PropertyInterface);
end;
hasMembers := True; hasMembers := True;
localHasMembers := True; end;
end;
end; end;
dxsImplementation: dxsImplementation:
begin begin
@ -742,34 +621,18 @@ begin
dxmPropertyGet: dxmPropertyGet:
begin begin
if writeOptional then if writeOptional then
begin sourceCode.Add(PropertyImplMethodGetOptional);
sourceCode.Add('function TXML%<Name>:s.GetHas%<PropertyName>:s: Boolean;');
sourceCode.Add('begin');
sourceCode.Add(' Result := Assigned(ChildNodes.FindNode(''%<PropertySourceName>:s''));');
sourceCode.Add('end;');
sourceCode.AddLn;
end;
if writeTextProp then if writeTextProp then
begin sourceCode.Add(PropertyImplMethodGetText);
sourceCode.Add('function TXML%<Name>:s.Get%<PropertyName>:sText: WideString;');
sourceCode.Add('begin');
sourceCode.Add(' Result := ChildNodes[''%<PropertySourceName>:s''].NodeValue;');
sourceCode.Add('end;');
sourceCode.AddLn;
end;
sourceCode.Add('function TXML%<Name>:s.Get%<PropertyName>:s: %<DataType>:s;'); sourceCode.Add('function TXML%<Name>:s.Get%<PropertyName>:s: %<DataType>:s;');
case itemProperty.PropertyType of case itemProperty.PropertyType of
ptSimple: ptSimple:
begin sourceCode.Add(XMLToNativeDataType('Result',
sourceCode.Add('begin'); 'ChildNodes[''%<PropertySourceName>:s''].NodeValue',
sourceCode.Add(' Result := ChildNodes[''%<PropertySourceName>:s''].NodeValue;'); TXMLDataBindingSimpleProperty(itemProperty).DataType));
sourceCode.Add('end;');
end;
ptItem: ptItem:
begin begin
@ -799,6 +662,7 @@ begin
sourceCode.Add(' Result := enumValue;'); sourceCode.Add(' Result := enumValue;');
sourceCode.Add(' break;'); sourceCode.Add(' break;');
sourceCode.Add(' end;'); sourceCode.Add(' end;');
sourceCode.Add('end;');
end; end;
end; end;
end; end;
@ -811,24 +675,25 @@ begin
if not itemProperty.IsReadOnly then if not itemProperty.IsReadOnly then
begin begin
if writeTextProp then if writeTextProp then
begin sourceCode.Add(PropertyImplMethodSetText);
sourceCode.Add('procedure TXML%<Name>:s.Set%<PropertyName>:sText(const Value: WideString);');
sourceCode.Add('begin');
sourceCode.Add(' ChildNodes[''%<PropertySourceName>:s''].NodeValue := Value;');
sourceCode.Add('end;');
sourceCode.AddLn;
end;
if Assigned(propertyItem) and (propertyItem.ItemType = itEnumeration) then
value := '%<PropertyItemName>:sValues[Value]'
else
value := 'Value';
sourceCode.Add('procedure TXML%<Name>:s.Set%<PropertyName>:s(const Value: %<DataType>:s);'); sourceCode.Add('procedure TXML%<Name>:s.Set%<PropertyName>:s(const Value: %<DataType>:s);');
value := 'ChildNodes[''%<PropertySourceName>:s''].NodeValue';
if Assigned(propertyItem) and (propertyItem.ItemType = itEnumeration) then
begin
sourceCode.Add('begin'); sourceCode.Add('begin');
sourceCode.Add(' ChildNodes[''%<PropertySourceName>:s''].NodeValue := ' + value + ';'); sourceCode.Add(' ' + value + ' := %<PropertyItemName>:sValues[Value]');
sourceCode.Add('end;'); sourceCode.Add('end;');
sourceCode.AddLn; 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;
end; end;
@ -900,22 +765,26 @@ procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollectionProperties(AStream
var var
dataIntfName: string; dataIntfName: string;
dataTypeName: string; dataTypeName: string;
dataClassName: string;
sourceCode: TNamedFormatStringList; sourceCode: TNamedFormatStringList;
typeDef: IXMLTypeDef;
begin begin
if ASection = dxsClass then if ASection = dxsClass then
AStream.WriteLn(' protected'); 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 case AItem.CollectionItem.PropertyType of
ptSimple: ptSimple:
begin begin
dataTypeName := AItem.CollectionItem.TranslatedName; dataTypeName := TranslateDataType(TXMLDataBindingSimpleProperty(AItem.CollectionItem).DataType);
dataClassName := 'TXMLNode';
dataIntfName := 'IXMLNode'; dataIntfName := 'IXMLNode';
end; end;
ptItem: ptItem:
begin begin
dataTypeName := PrefixInterface + AItem.CollectionItem.TranslatedName; dataTypeName := PrefixInterface + AItem.CollectionItem.TranslatedName;
dataClassName := PrefixClass + AItem.CollectionItem.TranslatedName;
dataIntfName := dataTypeName; dataIntfName := dataTypeName;
end; end;
end; end;
@ -927,17 +796,26 @@ begin
dxsClass: dxsClass:
begin begin
sourceCode.Add(' function Get_%<ItemName>:s(Index: Integer): %<DataType>:s;'); sourceCode.Add(' function Get_%<ItemName>:s(Index: Integer): %<DataType>:s;');
case AItem.CollectionItem.PropertyType of
ptSimple:
begin
sourceCode.Add(' function Add(%<ItemName>:s: %<DataType>:s): %<DataInterface>:s;');
sourceCode.Add(' function Insert(Index: Integer; %<ItemName>:s: %<DataType>:s): %<DataInterface>:s;');
end;
ptItem:
begin
sourceCode.Add(' function Add: %<DataType>:s;'); sourceCode.Add(' function Add: %<DataType>:s;');
sourceCode.Add(' function Insert(Index: Integer): %<DataType>:s;'); sourceCode.Add(' function Insert(Index: Integer): %<DataType>:s;');
end; end;
end;
end;
dxsImplementation: dxsImplementation:
begin begin
sourceCode.Add('procedure TXML%<Name>:s.AfterConstruction;'); sourceCode.Add('procedure TXML%<Name>:s.AfterConstruction;');
sourceCode.Add('begin'); sourceCode.Add('begin');
sourceCode.Add(' RegisterChildNode(''%<ItemSourceName>:s'', %<DataClass>:s);');
// #ToDo1 (MvR) 17-3-2008: DataType class / interface!!
sourceCode.Add(' RegisterChildNode(''%<ItemSourceName>:s'', %<DataType>:s);');
sourceCode.AddLn; sourceCode.AddLn;
sourceCode.Add(' ItemTag := ''%<ItemSourceName>:s'';'); sourceCode.Add(' ItemTag := ''%<ItemSourceName>:s'';');
sourceCode.Add(' ItemInterface := %<DataInterface>:s;'); sourceCode.Add(' ItemInterface := %<DataInterface>:s;');
@ -946,25 +824,52 @@ begin
sourceCode.Add('end;'); sourceCode.Add('end;');
sourceCode.AddLn; sourceCode.AddLn;
case AItem.CollectionItem.PropertyType of
ptSimple:
begin
typeDef := TXMLDataBindingSimpleProperty(AItem.CollectionItem).DataType;
// #ToDo1 (MvR) 19-3-2008: .Text for strings ?
sourceCode.Add('function TXML%<Name>:s.Get_%<ItemName>:s(Index: Integer): %<DataType>:s;');
sourceCode.Add(XMLToNativeDataType('Result', 'List[Index].NodeValue', typeDef));
sourceCode.AddLn;
sourceCode.Add('function TXML%<Name>:s.Add(%<ItemName>:s: %<DataType>:s): %<DataInterface>:s;');
sourceCode.Add(NativeDataTypeToXML('Result.NodeValue', '%<ItemName>:s', typeDef,
' Result := AddItem(-1);'));
sourceCode.AddLn;
sourceCode.Add('function TXML%<Name>:s.Insert(Index: Integer; %<ItemName>:s: %<DataType>:s): %<DataInterface>:s;');
sourceCode.Add(NativeDataTypeToXML('Result.NodeValue', '%<ItemName>:s', typeDef,
' Result := AddItem(Index);'));
sourceCode.AddLn;
end;
ptItem:
begin
sourceCode.Add('function TXML%<Name>:s.Get_%<ItemName>:s(Index: Integer): %<DataType>:s;'); sourceCode.Add('function TXML%<Name>:s.Get_%<ItemName>:s(Index: Integer): %<DataType>:s;');
sourceCode.Add('begin'); sourceCode.Add('begin');
sourceCode.Add(' Result := (List[Index] as %<DataType>:s;'); sourceCode.Add(' Result := (List[Index] as %<DataType>:s);');
sourceCode.Add('end;'); sourceCode.Add('end;');
sourceCode.AddLn; sourceCode.AddLn;
sourceCode.Add('function TXML%<Name>:s.Add(Index: Integer): %<DataType>:s;'); sourceCode.Add('function TXML%<Name>:s.Add: %<DataType>:s;');
sourceCode.Add('begin'); sourceCode.Add('begin');
sourceCode.Add(' Result := (AddItem(-1) as %<DataType>:s;'); sourceCode.Add(' Result := (AddItem(-1) as %<DataType>:s);');
sourceCode.Add('end;'); sourceCode.Add('end;');
sourceCode.AddLn; sourceCode.AddLn;
sourceCode.Add('function TXML%<Name>:s.Insert(Index: Integer): %<DataType>:s;'); sourceCode.Add('function TXML%<Name>:s.Insert(Index: Integer): %<DataType>:s;');
sourceCode.Add('begin'); sourceCode.Add('begin');
sourceCode.Add(' Result := (AddItem(Index) as %<DataType>:s;'); sourceCode.Add(' Result := (AddItem(Index) as %<DataType>:s);');
sourceCode.Add('end;'); sourceCode.Add('end;');
sourceCode.AddLn; sourceCode.AddLn;
end; end;
end; end;
end;
end;
case ASection of case ASection of
dxsInterface: dxsInterface:
@ -984,6 +889,7 @@ begin
'ItemName', AItem.CollectionItem.TranslatedName, 'ItemName', AItem.CollectionItem.TranslatedName,
'ItemSourceName', AItem.CollectionItem.Name, 'ItemSourceName', AItem.CollectionItem.Name,
'DataType', dataTypeName, 'DataType', dataTypeName,
'DataClass', dataClassName,
'DataInterface', dataIntfName])); 'DataInterface', dataIntfName]));
finally finally
FreeAndNil(sourceCode); FreeAndNil(sourceCode);
@ -1056,6 +962,55 @@ begin
end; 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; function TDelphiXMLDataBindingGenerator.CreateNewGUID(): String;
var var
guid: TGUID; guid: TGUID;

213
Units/DelphiXMLDataBindingResources.pas Normal file
View File

@ -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: %<SourceFileName>:s' + CrLf +
'}' + CrLf +
'unit %<UnitName>: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(''%<SourceName>:s'', TXML%<Name>:s, TargetNamespace) as IXML%<Name>:s';
DocumentFunctionsInterface = ' function Get%<Name>:s(ADocument: IXMLDocument): IXML%<Name>:s;' + CrLf +
' function Load%<Name>:s(const AFileName: String): IXML%<Name>:s;' + CrLf +
' function Load%<Name>:sFromStream(AStream: TStream): IXML%<Name>:s;' + CrLf +
' function New%<Name>:s: IXML%<Name>:s;' + CrLf;
DocumentFunctionsImplementation = 'function Get%<Name>:s(ADocument: IXMLDocument): IXML%<Name>:s;' + CrLf +
'begin' + CrLf +
' Result := ADocument.' + DocumentBinding + CrLf +
'end;' + CrLf +
'' + CrLf +
'function Load%<Name>:s(const AFileName: String): IXML%<Name>:s;' + CrLf +
'begin' + CrLf +
' Result := LoadXMLDocument(AFileName).' + DocumentBinding + CrLf +
'end;' + CrLf +
'' + CrLf +
'function Load%<Name>:sFromStream(AStream: TStream): IXML%<Name>:s;' + CrLf +
'var' + CrLf +
' doc: IXMLDocument;' + CrLf +
'' + CrLf +
'begin' + CrLf +
' doc := NewXMLDocument;' + CrLf +
' doc.LoadFromStream(AStream);' + CrLf +
' Result := Get%<Name>:s(doc);' + CrLf +
'end;' + CrLf +
'' + CrLf +
'function New%<Name>:s: IXML%<Name>:s;' + CrLf +
'begin' + CrLf +
' Result := NewXMLDocument.' + DocumentBinding + CrLf +
'end;' + CrLf +
'' + CrLf;
PropertyIntfMethodGetOptional = ' function GetHas%<PropertyName>:s: Boolean;';
PropertyIntfMethodGetText = ' function Get%<PropertyName>:sText: WideString;';
PropertyIntfMethodGet = ' function Get%<PropertyName>:s: %<DataType>:s;';
PropertyIntfMethodSetText = ' procedure Set%<PropertyName>:sText(const Value: WideString);';
PropertyIntfMethodSet = ' procedure Set%<PropertyName>:s(const Value: %<DataType>:s);';
PropertyInterfaceOptional = ' property Has%<PropertyName>:s: Boolean read GetHas%<PropertyName>:s;';
PropertyInterfaceTextReadOnly = ' property %<PropertyName>:sText: WideString read Get%<PropertyName>:sText;';
PropertyInterfaceReadOnly = ' property %<PropertyName>:s: %<DataType>:s read Get%<PropertyName>:s;';
PropertyInterfaceText = ' property %<PropertyName>:sText: WideString read Get%<PropertyName>:sText write Set%<PropertyName>:sText;';
PropertyInterface = ' property %<PropertyName>:s: %<DataType>:s read Get%<PropertyName>:s write Set%<PropertyName>:s;';
PropertyImplMethodGetOptional = 'function TXML%<Name>:s.GetHas%<PropertyName>:s: Boolean;' + CrLf +
'begin' + CrLf +
' Result := Assigned(ChildNodes.FindNode(''%<PropertySourceName>:s''));' + CrLf +
'end;' + CrLf +
'' + CrLf;
PropertyImplMethodGetText = 'function TXML%<Name>:s.Get%<PropertyName>:sText: WideString;' + CrLf +
'begin' + CrLf +
' Result := ChildNodes[''%<PropertySourceName>:s''].NodeValue;' + CrLf +
'end;' + CrLf +
'' + CrLf;
PropertyImplMethodSetText = 'procedure TXML%<Name>:s.Set%<PropertyName>:sText(const Value: WideString);' + CrLf +
'begin' + CrLf +
' ChildNodes[''%<PropertySourceName>:s''].NodeValue := Value;' + CrLf +
'end;' + CrLf +
'' + CrLf;
SectionComments: array[TDelphiXMLSection] of String =
(
' { Forward declarations for %<SchemaName>:s }',
' { Interfaces for %<SchemaName>:s }',
' { Classes for %<SchemaName>:s }',
'{ Implementation for %<SchemaName>:s }'
);
PrefixInterface = 'IXML';
PrefixClass = 'TXML';
InterfaceItemForward = ' IXML%<Name>:s = interface;';
InterfaceItemInterface = ' IXML%<Name>:s = interface(%<ParentName>:s)';
InterfaceItemClass = ' TXML%<Name>:s = class(%<ParentName>:s, IXML%<Name>: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 = ' %<Destination>:s := %<Source>: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 } ' %<Destination>:s := LowerCase(BoolToStr(%<Source>:s, True));',
{ tcFloat } TypeConversionNone,
{ tcDateTime } TypeConversionNone
);
implementation
end.

8
Units/XMLDataBindingGenerator.pas
View File

@ -2,7 +2,7 @@ unit XMLDataBindingGenerator;
// #ToDo1 (MvR) 7-3-2008: check if List items can be collapsed if an item is // #ToDo1 (MvR) 7-3-2008: check if List items can be collapsed if an item is
// already a list parent // already a list parent
// #ToDo3 (MvR) 7-3-2008: enum collections? // #ToDo1 (MvR) 19-3-2008: attributes
interface interface
uses uses
Classes, Classes,
@ -344,6 +344,11 @@ begin
for schemaIndex := 0 to Pred(SchemaCount) do for schemaIndex := 0 to Pred(SchemaCount) do
ResolveSchema(Schemas[schemaIndex]); ResolveSchema(Schemas[schemaIndex]);
{ Collapse collections }
{ Resolve naming conflicts }
ResolveNameConflicts(); ResolveNameConflicts();
@ -592,7 +597,6 @@ begin
interfaceObject.BaseName := AElement.DataType.BaseTypeName; interfaceObject.BaseName := AElement.DataType.BaseTypeName;
ASchema.AddItem(interfaceObject); ASchema.AddItem(interfaceObject);
Result := interfaceObject; Result := interfaceObject;
end; end;

2
X2XMLDataBindingCmdLine.dof
View File

@ -100,7 +100,7 @@ Conditionals=
DebugSourceDirs= DebugSourceDirs=
UsePackages=0 UsePackages=0
[Parameters] [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= HostApplication=
Launcher= Launcher=
UseLauncher=0 UseLauncher=0

3
X2XMLDataBindingCmdLine.dpr
View File

@ -5,7 +5,8 @@ uses
SysUtils, SysUtils,
DelphiXMLDataBindingGenerator in 'Units\DelphiXMLDataBindingGenerator.pas', DelphiXMLDataBindingGenerator in 'Units\DelphiXMLDataBindingGenerator.pas',
XMLDataBindingGenerator in 'Units\XMLDataBindingGenerator.pas', XMLDataBindingGenerator in 'Units\XMLDataBindingGenerator.pas',
XMLDataBindingHelpers in 'Units\XMLDataBindingHelpers.pas'; XMLDataBindingHelpers in 'Units\XMLDataBindingHelpers.pas',
DelphiXMLDataBindingResources in 'Units\DelphiXMLDataBindingResources.pas';
begin begin
CoInitialize(nil); CoInitialize(nil);