475 lines
14 KiB
ObjectPascal
475 lines
14 KiB
ObjectPascal
unit DelphiXMLDataBindingGenerator;
|
|
|
|
interface
|
|
uses
|
|
Classes,
|
|
XMLSchema,
|
|
|
|
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;
|
|
protected
|
|
procedure GenerateDataBinding(); override;
|
|
procedure GenerateSingleDataBinding();
|
|
procedure GenerateMultipleDataBinding();
|
|
|
|
function DoGetFileName(const ASchemaName: String): String;
|
|
|
|
function TranslateDataType(ADataType: IXMLTypeDef): String;
|
|
function CreateNewGUID(): String;
|
|
|
|
procedure WriteUnitHeader(AStream: TStreamHelper; const AFileName: String);
|
|
procedure WriteInterface(AStream: TStreamHelper; ASchemaDef: IXMLSchemaDef; ASection: TDelphiXMLSection);
|
|
|
|
procedure WriteComplexElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; ASection: TDelphiXMLSection);
|
|
function WriteSimpleElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; AMember: TDelphiXMLMember): Boolean;
|
|
procedure WriteEnumeration(AStream: TStreamHelper; AElement: IXMLElementDef);
|
|
|
|
procedure WriteElements(AStream: TStreamHelper; AElements: IXMLElementDefs); overload;
|
|
procedure WriteElements(AStream: TStreamHelper; AElements: IXMLElementDefList); overload;
|
|
|
|
procedure WriteImplementation(AStream: TStreamHelper);
|
|
procedure WriteUnitFooter(AStream: TStreamHelper);
|
|
public
|
|
property OnGetFileName: TGetFileNameEvent read FOnGetFileName write FOnGetFileName;
|
|
end;
|
|
|
|
implementation
|
|
uses
|
|
SysUtils;
|
|
|
|
|
|
const
|
|
SectionComments: array[TDelphiXMLSection] of String =
|
|
(
|
|
' { Forward declarations for %s }',
|
|
' { Interfaces for %s }',
|
|
' { Classes for %s }',
|
|
'{ Implementation for %s }'
|
|
);
|
|
|
|
MemberPropertyGet = ' function Get%0:s: %1:s;';
|
|
MemberPropertySet = ' procedure Set%0:s(const Value: %1:s);';
|
|
MemberProperty = ' property %0:s: %1:s read Get%0:s write Set%0:s;';
|
|
MemberPropertyReadOnly = ' property %0:s: %1:s read Get%0:s;';
|
|
|
|
|
|
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'
|
|
);
|
|
|
|
|
|
{ TDelphiXMLDataBindingGenerator }
|
|
procedure TDelphiXMLDataBindingGenerator.GenerateDataBinding();
|
|
begin
|
|
case OutputType of
|
|
otSingle: GenerateSingleDataBinding();
|
|
otMultiple: GenerateMultipleDataBinding();
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.GenerateSingleDataBinding();
|
|
var
|
|
unitName: String;
|
|
unitStream: TStreamHelper;
|
|
schemaIndex: Integer;
|
|
section: TDelphiXMLSection;
|
|
|
|
begin
|
|
unitName := DoGetFileName(Schema[0].SchemaName);
|
|
unitStream := TStreamHelper.Create(TFileStream.Create(unitName, fmCreate), soOwned);
|
|
try
|
|
WriteUnitHeader(unitStream, unitName);
|
|
unitStream.WriteLn('type');
|
|
unitStream.WriteLn(' TXMLCollection = Variant;');
|
|
unitStream.WriteLn();
|
|
|
|
for section := dxsForward to dxsClass do
|
|
begin
|
|
for schemaIndex := 0 to Pred(SchemaCount) do
|
|
begin
|
|
unitStream.WriteLn(Format(SectionComments[section], [Schema[schemaIndex].SchemaName]));
|
|
WriteInterface(unitStream, Schema[schemaIndex].SchemaDef, section);
|
|
unitStream.WriteLn();
|
|
end;
|
|
end;
|
|
|
|
unitStream.WriteLn();
|
|
WriteImplementation(unitStream);
|
|
|
|
for schemaIndex := 0 to Pred(SchemaCount) do
|
|
begin
|
|
unitStream.WriteLn(Format(SectionComments[dxsImplementation], [Schema[schemaIndex].SchemaName]));
|
|
WriteInterface(unitStream, Schema[schemaIndex].SchemaDef, dxsImplementation);
|
|
unitStream.WriteLn();
|
|
end;
|
|
|
|
WriteUnitFooter(unitStream);
|
|
finally
|
|
FreeAndNil(unitStream);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.GenerateMultipleDataBinding();
|
|
begin
|
|
end;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.TranslateDataType(ADataType: IXMLTypeDef): String;
|
|
begin
|
|
Result := 'Variant';
|
|
|
|
// #ToDo1 (MvR) 26-2-2008: check type mapping
|
|
if ADataType.IsComplex then
|
|
begin
|
|
Result := 'IXML' + ADataType.Name;
|
|
end else if ADataType.Enumerations.Count > 0 then
|
|
begin
|
|
Result := 'TXML' + ADataType.Name;
|
|
end else
|
|
begin
|
|
if ADataType.NamespaceURI = SXMLSchemaURI_2001 then
|
|
begin
|
|
if ADataType.Name = 'int' then
|
|
Result := 'Integer'
|
|
else if ADataType.Name = 'float' then
|
|
Result := 'Double'
|
|
else if ADataType.Name = 'boolean' then
|
|
Result := 'Boolean'
|
|
else if ADataType.Name = 'string' then
|
|
Result := 'String';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; const AFileName: String);
|
|
begin
|
|
// #ToDo1 (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();
|
|
AStream.WriteLn('interface');
|
|
AStream.WriteLn('uses');
|
|
AStream.WriteLn(' XMLDoc,');
|
|
AStream.WriteLn(' XMLIntf,');
|
|
AStream.WriteLn(' Variants;');
|
|
AStream.WriteLn();
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteInterface(AStream: TStreamHelper; ASchemaDef: IXMLSchemaDef; ASection: TDelphiXMLSection);
|
|
|
|
procedure ProcessElementDefs(AElements: IXMLElementDefList);
|
|
var
|
|
elementIndex: Integer;
|
|
element: IXMLElementDef;
|
|
|
|
begin
|
|
for elementIndex := 0 to Pred(AElements.Count) do
|
|
begin
|
|
element := AElements[elementIndex];
|
|
|
|
if not Assigned(element.Ref) then
|
|
begin
|
|
if element.DataType.IsComplex and
|
|
element.DataType.IsAnonymous then
|
|
begin
|
|
WriteComplexElementInterface(AStream, element, ASection);
|
|
ProcessElementDefs(element.ChildElements);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
elementIndex: Integer;
|
|
element: IXMLElementDef;
|
|
complexTypeIndex: Integer;
|
|
complexType: IXMLComplexTypeDef;
|
|
|
|
begin
|
|
for elementIndex := 0 to Pred(ASchemaDef.ElementDefs.Count) do
|
|
begin
|
|
element := ASchemaDef.ElementDefs[elementIndex];
|
|
|
|
if element.DataType.Enumerations.Count > 0 then
|
|
begin
|
|
{ Enumerated type }
|
|
if ASection = dxsForward then
|
|
WriteEnumeration(AStream, element);
|
|
end else
|
|
begin
|
|
{ Element }
|
|
WriteComplexElementInterface(AStream, element, ASection);
|
|
if element.DataType.IsComplex then
|
|
begin
|
|
ProcessElementDefs(element.ChildElements);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
for complexTypeIndex := 0 to Pred(ASchemaDef.ComplexTypes.Count) do
|
|
begin
|
|
complexType := ASchemaDef.ComplexTypes[complexTypeIndex];
|
|
|
|
case ASection of
|
|
dxsForward:
|
|
begin
|
|
AStream.WriteLn(' IXML' + complexType.Name + ' = interface;');
|
|
end;
|
|
dxsInterface:
|
|
begin
|
|
AStream.WriteLn(' IXML' + complexType.Name + ' = interface(IXMLNode)');
|
|
AStream.WriteLn(' ' + CreateNewGUID());
|
|
WriteElements(AStream, complexType.ElementDefs);
|
|
AStream.WriteLn(' end;');
|
|
AStream.WriteLn();
|
|
end;
|
|
dxsClass:
|
|
begin
|
|
AStream.WriteLn(Format(' TXML%0:s = class(TXMLNode, IXML%0:s)', [complexType.Name]));
|
|
WriteElements(AStream, complexType.ElementDefs);
|
|
AStream.WriteLn(' end;');
|
|
AStream.WriteLn();
|
|
end;
|
|
dxsImplementation:
|
|
begin
|
|
|
|
end;
|
|
end;
|
|
|
|
ProcessElementDefs(complexType.ElementDefList);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteComplexElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; ASection: TDelphiXMLSection);
|
|
begin
|
|
case ASection of
|
|
dxsForward:
|
|
begin
|
|
AStream.WriteLn(' IXML' + AElement.Name + ' = interface;');
|
|
end;
|
|
dxsInterface:
|
|
begin
|
|
AStream.WriteLn(' IXML' + AElement.Name + ' = interface(IXMLNode)');
|
|
AStream.WriteLn(' ' + CreateNewGUID());
|
|
WriteElements(AStream, AElement.ChildElements);
|
|
AStream.WriteLn(' end;');
|
|
AStream.WriteLn();
|
|
end;
|
|
dxsClass:
|
|
begin
|
|
AStream.WriteLn(Format(' TXML%0:s = class(TXMLNode, IXML%0:s)', [AElement.Name]));
|
|
WriteElements(AStream, AElement.ChildElements);
|
|
AStream.WriteLn(' end;');
|
|
AStream.WriteLn();
|
|
end;
|
|
dxsImplementation:
|
|
begin
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.WriteSimpleElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; AMember: TDelphiXMLMember): Boolean;
|
|
var
|
|
isReadOnly: Boolean;
|
|
memberName: String;
|
|
dataType: String;
|
|
memberFormat: String;
|
|
|
|
begin
|
|
Result := False;
|
|
isReadOnly := AElement.DataType.IsComplex;
|
|
if isReadOnly and (AMember = dxmPropertySet) then
|
|
exit;
|
|
|
|
dataType := '';
|
|
// #ToDo1 (MvR) 22-2-2008: escape reserved words
|
|
memberName := AElement.Name;
|
|
|
|
if (AElement.MaxOccurs = 'unbounded') or
|
|
(AElement.MaxOccurs > 1) then
|
|
begin
|
|
{ Collection }
|
|
dataType := Format('IXML%sCollection', [AElement.Name]);
|
|
end else
|
|
begin
|
|
dataType := TranslateDataType(AElement.DataType);
|
|
end;
|
|
|
|
|
|
case AMember of
|
|
dxmPropertyGet:
|
|
memberFormat := MemberPropertyGet;
|
|
dxmPropertySet:
|
|
memberFormat := MemberPropertySet;
|
|
dxmPropertyDeclaration:
|
|
if isReadOnly then
|
|
memberFormat := MemberPropertyReadOnly
|
|
else
|
|
memberFormat := MemberProperty;
|
|
end;
|
|
|
|
AStream.Write(Format(memberFormat, [memberName, dataType]));
|
|
|
|
if AElement.MinOccurs = 0 then
|
|
{ Optional }
|
|
AStream.WriteLn(' { Optional }')
|
|
else
|
|
AStream.WriteLn();
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteEnumeration(AStream: TStreamHelper; AElement: IXMLElementDef);
|
|
var
|
|
enumerations: IXMLEnumerationCollection;
|
|
enumIndex: Integer;
|
|
enumStart: String;
|
|
lineIndent: String;
|
|
|
|
begin
|
|
enumerations := AElement.DataType.Enumerations;
|
|
if enumerations.Count = 0 then
|
|
exit;
|
|
|
|
// #ToDo1 (MvR) 26-2-2008: unique prefix?
|
|
enumStart := Format(' TXML%s = (', [AElement.Name]);
|
|
AStream.Write(enumStart);
|
|
lineIndent := StringOfChar(' ', Length(enumStart));
|
|
|
|
for enumIndex := 0 to Pred(enumerations.Count) do
|
|
begin
|
|
if enumIndex > 0 then
|
|
AStream.Write(lineIndent);
|
|
|
|
AStream.Write(Format('%s_%s', [AElement.Name, enumerations[enumIndex].Value]));
|
|
|
|
if enumIndex < Pred(enumerations.Count) then
|
|
AStream.WriteLn(',')
|
|
else
|
|
AStream.WriteLn(');');
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteElements(AStream: TStreamHelper; AElements: IXMLElementDefList);
|
|
var
|
|
elementIndex: Integer;
|
|
member: TDelphiXMLMember;
|
|
hasMembers: Boolean;
|
|
|
|
begin
|
|
for member := Low(TDelphiXMLMember) to High(TDelphiXMLMember) do
|
|
begin
|
|
hasMembers := False;
|
|
|
|
for elementIndex := 0 to Pred(AElements.Count) do
|
|
if WriteSimpleElementInterface(AStream, AElements[elementIndex], member) then
|
|
hasMembers := True;
|
|
|
|
if hasMembers and (member < High(TDelphiXMLMember)) then
|
|
AStream.WriteLn();
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteElements(AStream: TStreamHelper; AElements: IXMLElementDefs);
|
|
var
|
|
elementIndex: Integer;
|
|
member: TDelphiXMLMember;
|
|
hasMembers: Boolean;
|
|
|
|
begin
|
|
for member := Low(TDelphiXMLMember) to High(TDelphiXMLMember) do
|
|
begin
|
|
hasMembers := False;
|
|
|
|
for elementIndex := 0 to Pred(AElements.Count) do
|
|
if WriteSimpleElementInterface(AStream, AElements[elementIndex], member) then
|
|
hasMembers := True;
|
|
|
|
if hasMembers and (member < High(TDelphiXMLMember)) then
|
|
AStream.WriteLn();
|
|
end;
|
|
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;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.CreateNewGUID(): String;
|
|
var
|
|
guid: TGUID;
|
|
|
|
begin
|
|
Result := '{ GUID generation failed }';
|
|
if CreateGUID(guid) = S_OK then
|
|
Result := '[''' + GUIDToString(guid) + ''']';
|
|
end;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.DoGetFileName(const ASchemaName: String): String;
|
|
begin
|
|
Result := OutputPath;
|
|
|
|
if OutputType = otMultiple then
|
|
begin
|
|
Result := IncludeTrailingPathDelimiter(Result) + ASchemaName + '.pas';
|
|
if Assigned(FOnGetFileName) then
|
|
FOnGetFileName(Self, ASchemaName, Result);
|
|
end;
|
|
end;
|
|
|
|
end.
|