From f5131df456701ef2dc8fb18c1ac9d040253736dd Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Tue, 26 Feb 2008 21:53:11 +0000 Subject: [PATCH] Implemented simple interfaces --- Forms/MainFrm.dfm | 2 +- Forms/MainFrm.pas | 2 + Units/DelphiXMLDataBindingGenerator.pas | 342 +++++++++++++++++++++--- Units/XMLDataBindingGenerator.pas | 67 +++-- X2XMLDataBinding.bdsproj | 2 +- 5 files changed, 359 insertions(+), 56 deletions(-) diff --git a/Forms/MainFrm.dfm b/Forms/MainFrm.dfm index 12b442d..35199f3 100644 --- a/Forms/MainFrm.dfm +++ b/Forms/MainFrm.dfm @@ -35,7 +35,7 @@ object MainForm: TMainForm AddQuotes = False Anchors = [akLeft, akTop, akRight] TabOrder = 0 - Text = 'F:\XTxXSD\Offerte.xsd' + Text = 'F:\XTxXSD\TelefoonGegevens.xsd' end object gbOutput: TGroupBox Left = 8 diff --git a/Forms/MainFrm.pas b/Forms/MainFrm.pas index 54f03d9..5708ae0 100644 --- a/Forms/MainFrm.pas +++ b/Forms/MainFrm.pas @@ -58,6 +58,8 @@ uses procedure TMainForm.FormCreate(Sender: TObject); begin plOutput.ActivePageIndex := 0; + btnGenerate.Click; + ModalResult := mrCancel; end; diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas index dfa055a..c4e1462 100644 --- a/Units/DelphiXMLDataBindingGenerator.pas +++ b/Units/DelphiXMLDataBindingGenerator.pas @@ -11,6 +11,9 @@ uses 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; @@ -21,10 +24,19 @@ type function DoGetFileName(const ASchemaName: String): String; + function TranslateDataType(ADataType: IXMLTypeDef): String; + function CreateNewGUID(): String; + procedure WriteUnitHeader(AStream: TStreamHelper; const AFileName: String); - procedure WriteSchemaInterfaces(AStream: TStreamHelper; ASchemaDef: IXMLSchemaDef; AForward: Boolean); - procedure WriteElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; AForward: Boolean); - procedure WriteElements(AStream: TStreamHelper; AType: IXMLTypeDef); + 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 @@ -36,6 +48,46 @@ 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 @@ -51,6 +103,7 @@ var unitName: String; unitStream: TStreamHelper; schemaIndex: Integer; + section: TDelphiXMLSection; begin unitName := DoGetFileName(Schema[0].SchemaName); @@ -58,20 +111,29 @@ begin try WriteUnitHeader(unitStream, unitName); unitStream.WriteLn('type'); + unitStream.WriteLn(' TXMLCollection = Variant;'); + unitStream.WriteLn(); - for schemaIndex := 0 to Pred(SchemaCount) do + for section := dxsForward to dxsClass do begin - unitStream.WriteLn(' { Forward declarations for ' + Schema[schemaIndex].SchemaName + ' }'); - WriteSchemaInterfaces(unitStream, Schema[schemaIndex].SchemaDef, True); - end; - - for schemaIndex := 0 to Pred(SchemaCount) do - begin - unitStream.WriteLn(' { Interfaces for ' + Schema[schemaIndex].SchemaName + ' }'); - WriteSchemaInterfaces(unitStream, Schema[schemaIndex].SchemaDef, False); + 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); @@ -84,6 +146,34 @@ 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 @@ -97,12 +187,13 @@ begin AStream.WriteLn('interface'); AStream.WriteLn('uses'); AStream.WriteLn(' XMLDoc,'); - AStream.WriteLn(' XMLIntf;'); + AStream.WriteLn(' XMLIntf,'); + AStream.WriteLn(' Variants;'); AStream.WriteLn(); end; -procedure TDelphiXMLDataBindingGenerator.WriteSchemaInterfaces(AStream: TStreamHelper; ASchemaDef: IXMLSchemaDef; AForward: Boolean); +procedure TDelphiXMLDataBindingGenerator.WriteInterface(AStream: TStreamHelper; ASchemaDef: IXMLSchemaDef; ASection: TDelphiXMLSection); procedure ProcessElementDefs(AElements: IXMLElementDefList); var @@ -114,10 +205,14 @@ procedure TDelphiXMLDataBindingGenerator.WriteSchemaInterfaces(AStream: TStreamH begin element := AElements[elementIndex]; - if element.DataType.IsComplex then + if not Assigned(element.Ref) then begin - WriteElementInterface(AStream, element, AForward); - ProcessElementDefs(element.ChildElements); + if element.DataType.IsComplex and + element.DataType.IsAnonymous then + begin + WriteComplexElementInterface(AStream, element, ASection); + ProcessElementDefs(element.ChildElements); + end; end; end; end; @@ -133,10 +228,19 @@ begin begin element := ASchemaDef.ElementDefs[elementIndex]; - WriteElementInterface(AStream, element, AForward); - if element.DataType.IsComplex then + if element.DataType.Enumerations.Count > 0 then begin - ProcessElementDefs(element.ChildElements); + { 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; @@ -144,18 +248,30 @@ begin begin complexType := ASchemaDef.ComplexTypes[complexTypeIndex]; - if AForward then - begin - AStream.WriteLn(' IXML' + complexType.Name + ' = interface; { ComplexType }'); - end else - begin - AStream.WriteLn(' IXML' + complexType.Name + ' = interface'); - AStream.WriteLn(' {TODO:GUID}'); + 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 - WriteElements(complexType); - - AStream.WriteLn(' end;'); - AStream.WriteLn(); + end; end; ProcessElementDefs(complexType.ElementDefList); @@ -163,20 +279,165 @@ begin end; -procedure TDelphiXMLDataBindingGenerator.WriteElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; AForward: Boolean); +procedure TDelphiXMLDataBindingGenerator.WriteComplexElementInterface(AStream: TStreamHelper; AElement: IXMLElementDef; ASection: TDelphiXMLSection); begin - if AForward then + 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 - AStream.WriteLn(' IXML' + AElement.Name + ' = interface; { ElementDef }'); + { Collection } + dataType := Format('IXML%sCollection', [AElement.Name]); end else begin - // #ToDo1 (MvR) 14-4-2007: output element interface + 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; @@ -187,6 +448,17 @@ begin 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; diff --git a/Units/XMLDataBindingGenerator.pas b/Units/XMLDataBindingGenerator.pas index 388a0aa..34844ca 100644 --- a/Units/XMLDataBindingGenerator.pas +++ b/Units/XMLDataBindingGenerator.pas @@ -32,6 +32,7 @@ type protected function LoadSchema(const AStream: TStream; const ASchemaName: String): IXMLSchemaDef; function FindSchema(const ALocation: String): TStream; + function SchemaLoaded(const ALocation: String): Boolean; procedure GenerateDataBinding(); virtual; abstract; @@ -124,11 +125,35 @@ end; function TXMLDataBindingGenerator.LoadSchema(const AStream: TStream; const ASchemaName: String): IXMLSchemaDef; + + procedure HandleDocRefs(const ADocRefs: IXMLSchemaDocRefs); + var + location: String; + refIndex: Integer; + refStream: TStream; + + begin + for refIndex := 0 to Pred(ADocRefs.Count) do + begin + location := ADocRefs[refIndex].SchemaLocation; + + if not SchemaLoaded(ChangeFileExt(location, '')) then + begin + refStream := FindSchema(location); + + if Assigned(refStream) then + try + location := ChangeFileExt(ExtractFileName(location), ''); + LoadSchema(refStream, location); + finally + FreeAndNil(refStream); + end; + end; + end; + end; + + var - includeIndex: Integer; - includes: IXMLSchemaIncludes; - includeStream: TStream; - location: String; schema: TXMLDataBindingSchema; schemaDoc: IXMLSchemaDoc; @@ -142,21 +167,9 @@ begin schema.SchemaName := ASchemaName; FSchemas.Add(schema); - { Handle includes } - includes := Result.SchemaIncludes; - for includeIndex := 0 to Pred(includes.Count) do - begin - location := includes[includeIndex].SchemaLocation; - includeStream := FindSchema(location); - - if Assigned(includeStream) then - try - location := ChangeFileExt(ExtractFileName(location), ''); - LoadSchema(includeStream, location); - finally - FreeAndNil(includeStream); - end; - end; + { Handle imports / includes } + HandleDocRefs(Result.SchemaImports); + HandleDocRefs(Result.SchemaIncludes); end; @@ -183,6 +196,22 @@ begin end; +function TXMLDataBindingGenerator.SchemaLoaded(const ALocation: String): Boolean; +var + schemaIndex: Integer; + +begin + Result := False; + + for schemaIndex := 0 to Pred(SchemaCount) do + if Schema[schemaIndex].SchemaName = ALocation then + begin + Result := True; + break; + end; +end; + + function TXMLDataBindingGenerator.GetSchemaCount(): Integer; begin Result := FSchemas.Count; diff --git a/X2XMLDataBinding.bdsproj b/X2XMLDataBinding.bdsproj index 572148e..0ec6262 100644 --- a/X2XMLDataBinding.bdsproj +++ b/X2XMLDataBinding.bdsproj @@ -123,7 +123,7 @@ - $(BDS)\lib\Debug;$(BDS)\Lib\Debug\Indy10 + madExcept