1
0
mirror of synced 2024-11-14 19:13:50 +00:00
x2xmldatabinding/Units/XMLDataBindingGenerator.pas

2084 lines
65 KiB
ObjectPascal
Raw Normal View History

2008-02-20 06:52:00 +00:00
unit XMLDataBindingGenerator;
// #ToDo2 (MvR) 25-4-2008: typed wrapper for NodeValue if needed (eg. element with attributes and a value)
2008-02-20 06:52:00 +00:00
interface
uses
Classes,
Contnrs,
XMLSchema;
type
2008-03-09 20:36:27 +00:00
TXMLDataBindingSchema = class;
2008-04-14 19:28:57 +00:00
TXMLDataBindingGeneratorItem = class;
2008-03-09 20:36:27 +00:00
TXMLDataBindingItem = class;
TXMLDataBindingInterface = class;
TXMLDataBindingEnumerationMember = class;
TXMLDataBindingEnumeration = class;
TXMLDataBindingProperty = class;
2008-04-21 15:24:33 +00:00
TXMLDataBindingItemProperty = class;
2008-04-14 19:28:57 +00:00
TXMLDataBindingUnresolvedItem = class;
2008-03-09 20:36:27 +00:00
2008-02-20 06:52:00 +00:00
TXMLDataBindingOutputType = (otSingle, otMultiple);
2008-04-14 19:28:57 +00:00
TXMLDataBindingItemType = (itInterface, itEnumeration, itEnumerationMember,
2008-04-18 14:36:17 +00:00
itProperty, itUnresolved,
itComplexTypeAlias, itSimpleTypeAlias);
TXMLDataBindingInterfaceType = (ifElement, ifComplexType, ifEnumeration);
2008-03-09 20:36:27 +00:00
TXMLDataBindingPropertyType = (ptSimple, ptItem);
2008-04-14 19:28:57 +00:00
TXMLDataBindingOccurance = (boMinOccurs, boMaxOccurs);
2008-03-09 20:36:27 +00:00
TXMLDataBindingIterateItemsProc = procedure(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean) of object;
TXMLDataBindingPostProcessItemEvent = procedure(Sender: TObject; Item: TXMLDataBindingItem) of object;
2008-03-09 20:36:27 +00:00
2008-02-20 06:52:00 +00:00
TXMLDataBindingGenerator = class(TObject)
private
FIncludePaths: TStrings;
2008-03-09 20:36:27 +00:00
FOutputPath: String;
2008-02-20 06:52:00 +00:00
FOutputType: TXMLDataBindingOutputType;
FSourceFileName: String;
FSchemas: TObjectList;
FOnPostProcessItem: TXMLDataBindingPostProcessItemEvent;
function GetSchemaCount: Integer;
2008-03-09 20:36:27 +00:00
function GetSchemas(Index: Integer): TXMLDataBindingSchema;
2008-02-20 06:52:00 +00:00
protected
2008-03-09 20:36:27 +00:00
function LoadSchema(const AStream: TStream; const ASchemaName: String): TXMLDataBindingSchema;
2008-04-14 19:28:57 +00:00
function GetSchemaData(const ALocation: String; out ASourceFileName: String): TStream;
2008-03-09 20:36:27 +00:00
function FindSchema(const ALocation: String): TXMLDataBindingSchema;
2008-03-09 20:36:27 +00:00
procedure GenerateSchemaObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean);
procedure GenerateElementObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean);
procedure GenerateComplexTypeObjects(ASchema: TXMLDataBindingSchema);
procedure GenerateSimpleTypeObjects(ASchema: TXMLDataBindingSchema);
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
function CheckElementOccurance(AElement: IXMLElementDef; AOccurance: TXMLDataBindingOccurance): Boolean;
function IsElementOptional(AElement: IXMLElementDef): Boolean;
function IsElementRepeating(AElement: IXMLElementDef): Boolean;
function IsChoice(AElement: IXMLElementDef): Boolean;
function ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem; overload;
function ProcessElement(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef): TXMLDataBindingItem; overload;
2008-03-09 20:36:27 +00:00
procedure ProcessChildElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef; AInterface: TXMLDataBindingInterface);
2008-04-14 19:28:57 +00:00
procedure ProcessAttribute(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef; AInterface: TXMLDataBindingInterface);
function ProcessSimpleTypeReference(ASchema: TXMLDataBindingSchema; AItem: IXMLSchemaItem; ADataType: IXMLTypeDef): TXMLDataBindingItem;
2008-03-09 20:36:27 +00:00
function IterateSchemaItems(ASchema: TXMLDataBindingSchema; AIterateProc: TXMLDataBindingIterateItemsProc; AData: Pointer): TXMLDataBindingItem;
procedure FindInterfaceProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean);
function FindInterface(ASchema: TXMLDataBindingSchema; const AName: String; AType: TXMLDataBindingInterfaceType): TXMLDataBindingInterface;
procedure FindEnumerationProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean);
function FindEnumeration(ASchema: TXMLDataBindingSchema; const AName: String; AAttribute: Boolean): TXMLDataBindingEnumeration;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem);
2008-03-09 20:36:27 +00:00
procedure ResolveSchema(ASchema: TXMLDataBindingSchema);
2008-04-14 19:28:57 +00:00
procedure ResolveAlias(ASchema: TXMLDataBindingSchema);
procedure ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingUnresolvedItem);
procedure ResolveNameConflicts; virtual;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
procedure PostProcessSchema(ASchema: TXMLDataBindingSchema);
procedure PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem); virtual;
2008-03-09 20:36:27 +00:00
function TranslateItemName(AItem: TXMLDataBindingItem): String; virtual;
2008-02-20 06:52:00 +00:00
procedure GenerateDataBinding; virtual; abstract;
2008-02-20 06:52:00 +00:00
2008-03-09 20:36:27 +00:00
property SourceFileName: String read FSourceFileName write FSourceFileName;
property SchemaCount: Integer read GetSchemaCount;
property Schemas[Index: Integer]: TXMLDataBindingSchema read GetSchemas;
2008-02-20 06:52:00 +00:00
public
constructor Create;
destructor Destroy; override;
2008-02-20 06:52:00 +00:00
procedure Execute(const AStream: TStream; const ASchemaName: String); overload;
procedure Execute(const AFileName: String); overload;
property IncludePaths: TStrings read FIncludePaths;
property OutputType: TXMLDataBindingOutputType read FOutputType write FOutputType;
2008-03-09 20:36:27 +00:00
property OutputPath: String read FOutputPath write FOutputPath;
property OnPostProcessItem: TXMLDataBindingPostProcessItemEvent read FOnPostProcessItem write FOnPostProcessItem;
2008-03-09 20:36:27 +00:00
end;
2008-04-14 19:28:57 +00:00
TXMLDataBindingGeneratorItem = class(TObject)
private
FOwner: TXMLDataBindingGenerator;
protected
procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); virtual;
property Owner: TXMLDataBindingGenerator read FOwner;
public
constructor Create(AOwner: TXMLDataBindingGenerator);
end;
TXMLDataBindingSchema = class(TXMLDataBindingGeneratorItem)
2008-03-09 20:36:27 +00:00
private
FIncludes: TObjectList;
FItems: TObjectList;
FItemsGenerated: Boolean;
FSchemaDef: IXMLSchemaDef;
FSchemaName: String;
2008-04-14 19:28:57 +00:00
FSourceFileName: String;
2008-03-09 20:36:27 +00:00
function GetItemCount: Integer;
2008-03-09 20:36:27 +00:00
function GetItems(Index: Integer): TXMLDataBindingItem;
function GetIncludeCount: Integer;
2008-03-09 20:36:27 +00:00
function GetIncludes(Index: Integer): TXMLDataBindingSchema;
function GetTargetNamespace: String;
2008-03-09 20:36:27 +00:00
protected
2008-04-14 19:28:57 +00:00
procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); override;
2008-03-09 20:36:27 +00:00
procedure AddInclude(ASchema: TXMLDataBindingSchema);
procedure AddItem(AItem: TXMLDataBindingItem);
2008-04-14 19:28:57 +00:00
procedure InsertItem(AItem, AAfter: TXMLDataBindingItem);
2008-03-09 20:36:27 +00:00
property ItemsGenerated: Boolean read FItemsGenerated write FItemsGenerated;
public
2008-04-14 19:28:57 +00:00
constructor Create(AOwner: TXMLDataBindingGenerator);
destructor Destroy; override;
2008-03-09 20:36:27 +00:00
property TargetNamespace: String read GetTargetNamespace;
2008-03-09 20:36:27 +00:00
property IncludeCount: Integer read GetIncludeCount;
property Includes[Index: Integer]: TXMLDataBindingSchema read GetIncludes;
2008-04-14 19:28:57 +00:00
property SchemaDef: IXMLSchemaDef read FSchemaDef write FSchemaDef;
property SchemaName: String read FSchemaName write FSchemaName;
property SourceFileName: String read FSourceFileName write FSourceFileName;
2008-03-09 20:36:27 +00:00
property ItemCount: Integer read GetItemCount;
property Items[Index: Integer]: TXMLDataBindingItem read GetItems;
end;
2008-04-14 19:28:57 +00:00
TXMLDataBindingItem = class(TXMLDataBindingGeneratorItem)
2008-03-09 20:36:27 +00:00
private
2008-04-14 19:28:57 +00:00
FCollectionItem: TXMLDataBindingProperty;
2008-03-09 20:36:27 +00:00
FDocumentElement: Boolean;
FName: String;
2008-04-14 19:28:57 +00:00
FSchema: TXMLDataBindingSchema;
2008-03-09 20:36:27 +00:00
FSchemaItem: IXMLSchemaItem;
FTranslatedName: String;
FTargetNamespace: String;
2008-03-09 20:36:27 +00:00
function GetDocumentation: String;
function GetHasDocumentation: Boolean;
2008-04-14 19:28:57 +00:00
function GetIsCollection: Boolean;
2008-03-09 20:36:27 +00:00
protected
function GetItemType: TXMLDataBindingItemType; virtual; abstract;
2008-03-09 20:36:27 +00:00
procedure SetName(const Value: String);
property SchemaItem: IXMLSchemaItem read FSchemaItem;
public
2008-04-14 19:28:57 +00:00
constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String);
property Schema: TXMLDataBindingSchema read FSchema write FSchema;
property TargetNamespace: String read FTargetNamespace write FTargetNamespace;
2008-03-09 20:36:27 +00:00
property DocumentElement: Boolean read FDocumentElement write FDocumentElement;
property Documentation: String read GetDocumentation;
property HasDocumentation: Boolean read GetHasDocumentation;
property ItemType: TXMLDataBindingItemType read GetItemType;
property Name: String read FName;
property TranslatedName: String read FTranslatedName write FTranslatedName;
2008-04-14 19:28:57 +00:00
property CollectionItem: TXMLDataBindingProperty read FCollectionItem write FCollectionItem;
property IsCollection: Boolean read GetIsCollection;
2008-03-09 20:36:27 +00:00
end;
TXMLDataBindingInterface = class(TXMLDataBindingItem)
private
FInterfaceType: TXMLDataBindingInterfaceType;
FIsSequence: Boolean;
2008-03-09 20:36:27 +00:00
FProperties: TObjectList;
FBaseName: String;
FBaseItem: TXMLDataBindingInterface;
function GetProperties(Index: Integer): TXMLDataBindingProperty;
function GetPropertyCount: Integer;
function GetCanValidate: Boolean;
2008-03-09 20:36:27 +00:00
protected
function GetItemType: TXMLDataBindingItemType; override;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
procedure ReplaceItem(const AOldItem: TXMLDataBindingItem; const ANewItem: TXMLDataBindingItem); override;
2008-03-09 20:36:27 +00:00
procedure AddProperty(AProperty: TXMLDataBindingProperty);
public
2008-04-14 19:28:57 +00:00
constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String);
2008-03-09 20:36:27 +00:00
destructor Destroy; override;
2008-04-14 19:28:57 +00:00
property BaseName: String read FBaseName write FBaseName;
property BaseItem: TXMLDataBindingInterface read FBaseItem write FBaseItem;
2008-03-09 20:36:27 +00:00
property CanValidate: Boolean read GetCanValidate;
2008-03-09 20:36:27 +00:00
property InterfaceType: TXMLDataBindingInterfaceType read FInterfaceType;
property IsSequence: Boolean read FIsSequence;
2008-03-09 20:36:27 +00:00
property PropertyCount: Integer read GetPropertyCount;
property Properties[Index: Integer]: TXMLDataBindingProperty read GetProperties;
end;
TXMLDataBindingEnumerationMember = class(TXMLDataBindingItem)
private
FEnumeration: TXMLDataBindingEnumeration;
protected
function GetItemType: TXMLDataBindingItemType; override;
2008-03-09 20:36:27 +00:00
public
2008-04-14 19:28:57 +00:00
constructor Create(AOwner: TXMLDataBindingGenerator; AEnumeration: TXMLDataBindingEnumeration; const AName: String);
2008-03-09 20:36:27 +00:00
property Enumeration: TXMLDataBindingEnumeration read FEnumeration;
end;
TXMLDataBindingEnumeration = class(TXMLDataBindingItem)
private
FMembers: TObjectList;
FIsAttribute: Boolean;
2008-03-09 20:36:27 +00:00
function GetMemberCount: Integer;
2008-03-09 20:36:27 +00:00
function GetMembers(Index: Integer): TXMLDataBindingEnumerationMember;
protected
function GetItemType: TXMLDataBindingItemType; override;
2008-03-09 20:36:27 +00:00
public
constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; AEnumerations: IXMLEnumerationCollection; const AName: String; AIsAttribute: Boolean);
destructor Destroy; override;
2008-03-09 20:36:27 +00:00
property MemberCount: Integer read GetMemberCount;
property Members[Index: Integer]: TXMLDataBindingEnumerationMember read GetMembers;
property IsAttribute: Boolean read FIsAttribute;
2008-03-09 20:36:27 +00:00
end;
TXMLDataBindingProperty = class(TXMLDataBindingItem)
private
FIsAttribute: Boolean;
FIsOptional: Boolean;
FIsNillable: Boolean;
FIsRepeating: Boolean;
FIsNodeValue: Boolean;
FCollection: TXMLDataBindingInterface;
function GetHasTargetNamespace: Boolean;
2008-03-09 20:36:27 +00:00
protected
function GetIsReadOnly: Boolean; virtual; abstract;
2008-03-09 20:36:27 +00:00
function GetItemType: TXMLDataBindingItemType; override;
function GetPropertyType: TXMLDataBindingPropertyType; virtual; abstract;
2008-03-09 20:36:27 +00:00
public
property IsAttribute: Boolean read FIsAttribute write FIsAttribute;
property IsOptional: Boolean read FIsOptional write FIsOptional;
property IsNillable: Boolean read FIsNillable write FIsNillable;
property IsReadOnly: Boolean read GetIsReadOnly;
property IsRepeating: Boolean read FIsRepeating write FIsRepeating;
property IsNodeValue: Boolean read FIsNodeValue write FIsNodeValue;
property PropertyType: TXMLDataBindingPropertyType read GetPropertyType;
property Collection: TXMLDataBindingInterface read FCollection write FCollection;
property HasTargetNamespace: Boolean read GetHasTargetNamespace;
2008-03-09 20:36:27 +00:00
end;
TXMLDataBindingSimpleProperty = class(TXMLDataBindingProperty)
private
FDataType: IXMLTypeDef;
protected
function GetIsReadOnly: Boolean; override;
function GetPropertyType: TXMLDataBindingPropertyType; override;
2008-03-09 20:36:27 +00:00
public
2008-04-14 19:28:57 +00:00
constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; ADataType: IXMLTypeDef);
2008-04-21 15:24:33 +00:00
constructor CreateFromAlias(AOwner: TXMLDataBindingGenerator; AProperty: TXMLDataBindingItemProperty; ADataType: IXMLTypeDef);
2008-03-09 20:36:27 +00:00
property DataType: IXMLTypeDef read FDataType;
end;
TXMLDataBindingItemProperty = class(TXMLDataBindingProperty)
private
FItem: TXMLDataBindingItem;
protected
function GetIsReadOnly: Boolean; override;
function GetPropertyType: TXMLDataBindingPropertyType; override;
2008-04-14 19:28:57 +00:00
procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); override;
2008-03-09 20:36:27 +00:00
public
2008-04-14 19:28:57 +00:00
constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AItem: TXMLDataBindingItem);
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
property Item: TXMLDataBindingItem read FItem;
2008-03-09 20:36:27 +00:00
end;
2008-04-14 19:28:57 +00:00
TXMLDataBindingUnresolvedItem = class(TXMLDataBindingItem)
2008-03-09 20:36:27 +00:00
private
FInterfaceType: TXMLDataBindingInterfaceType;
FIsAttribute: Boolean;
2008-03-09 20:36:27 +00:00
protected
function GetItemType: TXMLDataBindingItemType; override;
2008-03-09 20:36:27 +00:00
public
constructor Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType; AIsAttribute: Boolean);
2008-03-09 20:36:27 +00:00
property InterfaceType: TXMLDataBindingInterfaceType read FInterfaceType;
property IsAttribute: Boolean read FIsAttribute;
2008-02-20 06:52:00 +00:00
end;
2008-04-18 14:36:17 +00:00
TXMLDataBindingComplexTypeAliasItem = class(TXMLDataBindingItem)
private
FItem: TXMLDataBindingItem;
protected
function GetItemType: TXMLDataBindingItemType; override;
2008-04-14 19:28:57 +00:00
procedure ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem); override;
public
property Item: TXMLDataBindingItem read FItem write FItem;
end;
2008-04-18 14:36:17 +00:00
TXMLDataBindingSimpleTypeAliasItem = class(TXMLDataBindingItem)
private
FDataType: IXMLTypeDef;
protected
function GetItemType: TXMLDataBindingItemType; override;
2008-04-18 14:36:17 +00:00
public
property DataType: IXMLTypeDef read FDataType write FDataType;
end;
2008-02-20 06:52:00 +00:00
implementation
uses
SysUtils,
Variants,
2008-03-09 20:36:27 +00:00
Windows,
2008-02-20 06:52:00 +00:00
XMLDoc,
2008-03-09 20:36:27 +00:00
XMLIntf,
XMLSchemaTags,
2008-03-09 20:36:27 +00:00
X2UtHashes;
const
MaxOccursUnbounded = 'unbounded';
UseRequired = 'required';
CollectionPostfix = 'List';
2008-04-21 15:24:33 +00:00
AttributeNillable = 'nillable';
2008-03-09 20:36:27 +00:00
function GetInterfaceType(ASchemaItem: IXMLSchemaItem): TXMLDataBindingInterfaceType;
begin
if Supports(ASchemaItem, IXMLComplexTypeDef) then
Result := ifComplexType
else
Result := ifElement;
end;
2008-02-20 06:52:00 +00:00
2008-02-20 06:52:00 +00:00
{ TXMLDataBindingGenerator }
constructor TXMLDataBindingGenerator.Create;
2008-02-20 06:52:00 +00:00
begin
inherited Create;
2008-02-20 06:52:00 +00:00
FIncludePaths := TStringList.Create;
2008-02-20 06:52:00 +00:00
FSchemas := TObjectList.Create(True);
with TStringList(FIncludePaths) do
begin
CaseSensitive := False;
Duplicates := dupIgnore;
end;
IncludePaths.Add('');
2008-02-20 06:52:00 +00:00
end;
destructor TXMLDataBindingGenerator.Destroy;
2008-02-20 06:52:00 +00:00
begin
FreeAndNil(FSchemas);
FreeAndNil(FIncludePaths);
inherited;
end;
procedure TXMLDataBindingGenerator.Execute(const AStream: TStream; const ASchemaName: String);
2008-03-09 20:36:27 +00:00
var
schemaIndex: Integer;
2008-04-14 19:28:57 +00:00
schema: TXMLDataBindingSchema;
2008-03-09 20:36:27 +00:00
2008-02-20 06:52:00 +00:00
begin
FSchemas.Clear;
2008-04-14 19:28:57 +00:00
schema := LoadSchema(AStream, ASchemaName);
if Assigned(schema) then
schema.SourceFileName := SourceFileName;
2008-02-20 06:52:00 +00:00
if SchemaCount > 0 then
2008-03-09 20:36:27 +00:00
begin
{ Map schema elements to objects }
for schemaIndex := 0 to Pred(SchemaCount) do
GenerateSchemaObjects(Schemas[schemaIndex], (schemaIndex = 0));
2008-04-14 19:28:57 +00:00
{ Process unresolved references }
for schemaIndex := Pred(SchemaCount) downto 0 do
2008-03-09 20:36:27 +00:00
ResolveSchema(Schemas[schemaIndex]);
2008-04-14 19:28:57 +00:00
{ After all lookups have been done, unwrap alias items }
for schemaIndex := Pred(SchemaCount) downto 0 do
ResolveAlias(Schemas[schemaIndex]);
{ Resolve naming conflicts }
ResolveNameConflicts;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
{ Perform final post-processing (translating names, generating collections) }
2008-03-09 20:36:27 +00:00
for schemaIndex := 0 to Pred(SchemaCount) do
2008-04-14 19:28:57 +00:00
PostProcessSchema(Schemas[schemaIndex]);
2008-03-09 20:36:27 +00:00
{ Output }
GenerateDataBinding;
2008-03-09 20:36:27 +00:00
end;
2008-02-20 06:52:00 +00:00
end;
procedure TXMLDataBindingGenerator.Execute(const AFileName: String);
var
currentDir: String;
fileStream: TFileStream;
begin
currentDir := GetCurrentDir;
2008-02-20 06:52:00 +00:00
try
ChDir(ExtractFilePath(AFileName));
fileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
try
FSourceFileName := AFileName;
IncludePaths.Add(ExtractFilePath(AFileName));
Execute(fileStream, ChangeFileExt(ExtractFileName(AFileName), ''));
finally
FreeAndNil(fileStream);
end;
finally
ChDir(currentDir);
end;
end;
2008-03-09 20:36:27 +00:00
function TXMLDataBindingGenerator.LoadSchema(const AStream: TStream; const ASchemaName: String): TXMLDataBindingSchema;
2008-02-26 21:53:11 +00:00
2008-03-09 20:36:27 +00:00
procedure HandleDocRefs(const ADocRefs: IXMLSchemaDocRefs; ASchema: TXMLDataBindingSchema);
2008-02-26 21:53:11 +00:00
var
location: String;
2008-03-09 20:36:27 +00:00
schemaName: String;
refSchema: TXMLDataBindingSchema;
2008-02-26 21:53:11 +00:00
refIndex: Integer;
refStream: TStream;
2008-04-14 19:28:57 +00:00
sourceFileName: String;
2008-02-26 21:53:11 +00:00
begin
for refIndex := 0 to Pred(ADocRefs.Count) do
begin
location := ADocRefs[refIndex].SchemaLocation;
2008-03-09 20:36:27 +00:00
schemaName := ChangeFileExt(ExtractFileName(location), '');
refSchema := FindSchema(schemaName);
2008-02-26 21:53:11 +00:00
2008-03-09 20:36:27 +00:00
if not Assigned(refSchema) then
2008-02-26 21:53:11 +00:00
begin
2008-04-14 19:28:57 +00:00
refStream := GetSchemaData(location, sourceFileName);
2008-02-26 21:53:11 +00:00
if Assigned(refStream) then
try
2008-03-09 20:36:27 +00:00
refSchema := LoadSchema(refStream, schemaName);
2008-04-14 19:28:57 +00:00
if Assigned(refSchema) then
refSchema.SourceFileName := sourceFileName;
2008-02-26 21:53:11 +00:00
finally
FreeAndNil(refStream);
end;
end;
2008-03-09 20:36:27 +00:00
if Assigned(refSchema) then
ASchema.AddInclude(refSchema);
2008-02-26 21:53:11 +00:00
end;
end;
2008-02-20 06:52:00 +00:00
var
schemaDoc: IXMLSchemaDoc;
2008-03-09 20:36:27 +00:00
schemaDef: IXMLSchemaDef;
2008-02-20 06:52:00 +00:00
begin
schemaDoc := TXMLSchemaDoc.Create(nil);
schemaDoc.LoadFromStream(AStream);
2008-03-09 20:36:27 +00:00
schemaDef := schemaDoc.SchemaDef;
2008-02-20 06:52:00 +00:00
2008-04-14 19:28:57 +00:00
Result := TXMLDataBindingSchema.Create(Self);
2008-03-09 20:36:27 +00:00
Result.SchemaDef := schemaDef;
Result.SchemaName := ASchemaName;
FSchemas.Add(Result);
2008-02-20 06:52:00 +00:00
2008-02-26 21:53:11 +00:00
{ Handle imports / includes }
2008-03-09 20:36:27 +00:00
HandleDocRefs(schemaDef.SchemaImports, Result);
HandleDocRefs(schemaDef.SchemaIncludes, Result);
2008-02-20 06:52:00 +00:00
end;
2008-04-14 19:28:57 +00:00
function TXMLDataBindingGenerator.GetSchemaData(const ALocation: String; out ASourceFileName: String): TStream;
2008-02-20 06:52:00 +00:00
var
includeIndex: Integer;
includePath: String;
begin
Result := nil;
for includeIndex := 0 to Pred(IncludePaths.Count) do
begin
includePath := IncludePaths[includeIndex];
if Length(includePath) > 0 then
includePath := IncludeTrailingPathDelimiter(includePath);
2008-02-20 06:52:00 +00:00
if FileExists(includePath + ALocation) then
begin
2008-04-14 19:28:57 +00:00
ASourceFileName := includePath + ALocation;
Result := TFileStream.Create(ASourceFileName, fmOpenRead or fmShareDenyNone);
2008-02-20 06:52:00 +00:00
break;
end;
end;
end;
2008-03-09 20:36:27 +00:00
function TXMLDataBindingGenerator.FindSchema(const ALocation: String): TXMLDataBindingSchema;
2008-02-26 21:53:11 +00:00
var
schemaIndex: Integer;
begin
2008-03-09 20:36:27 +00:00
Result := nil;
2008-02-26 21:53:11 +00:00
for schemaIndex := 0 to Pred(SchemaCount) do
2008-03-09 20:36:27 +00:00
if Schemas[schemaIndex].SchemaName = ALocation then
2008-02-26 21:53:11 +00:00
begin
2008-03-09 20:36:27 +00:00
Result := Schemas[schemaIndex];
2008-02-26 21:53:11 +00:00
break;
end;
end;
2008-03-09 20:36:27 +00:00
procedure TXMLDataBindingGenerator.GenerateSchemaObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean);
var
includeIndex: Integer;
2008-02-20 06:52:00 +00:00
begin
2008-03-09 20:36:27 +00:00
if ASchema.ItemsGenerated then
exit;
ASchema.ItemsGenerated := True;
{ First generate the objects for all includes and imports, so we can get
proper references. }
for includeIndex := 0 to Pred(ASchema.IncludeCount) do
GenerateSchemaObjects(ASchema.Includes[includeIndex], False);
GenerateElementObjects(ASchema, ARootDocument);
GenerateComplexTypeObjects(ASchema);
GenerateSimpleTypeObjects(ASchema);
2008-02-20 06:52:00 +00:00
end;
2008-03-09 20:36:27 +00:00
procedure TXMLDataBindingGenerator.GenerateElementObjects(ASchema: TXMLDataBindingSchema; ARootDocument: Boolean);
var
schemaDef: IXMLSchemaDef;
elementIndex: Integer;
item: TXMLDataBindingItem;
attributeIndex: Integer;
2008-03-09 20:36:27 +00:00
2008-02-20 06:52:00 +00:00
begin
2008-03-09 20:36:27 +00:00
schemaDef := ASchema.SchemaDef;
for elementIndex := 0 to Pred(schemaDef.ElementDefs.Count) do
begin
item := ProcessElement(ASchema, schemaDef.ElementDefs[elementIndex]);
if Assigned(item) and ARootDocument then
item.DocumentElement := True;
end;
for attributeIndex := 0 to Pred(schemaDef.AttributeDefs.Count) do
ProcessElement(ASchema, schemaDef.AttributeDefs[attributeIndex]);
2008-02-20 06:52:00 +00:00
end;
2008-03-09 20:36:27 +00:00
procedure TXMLDataBindingGenerator.GenerateComplexTypeObjects(ASchema: TXMLDataBindingSchema);
var
schemaDef: IXMLSchemaDef;
complexTypeIndex: Integer;
complexType: IXMLComplexTypeDef;
interfaceItem: TXMLDataBindingInterface;
elementIndex: Integer;
attributeIndex: Integer;
2008-03-09 20:36:27 +00:00
begin
schemaDef := ASchema.SchemaDef;
for complexTypeIndex := 0 to Pred(schemaDef.ComplexTypes.Count) do
begin
complexType := schemaDef.ComplexTypes[complexTypeIndex];
2008-04-18 14:36:17 +00:00
2008-04-14 19:28:57 +00:00
interfaceItem := TXMLDataBindingInterface.Create(Self, complexType, complexType.Name);
2008-04-18 14:36:17 +00:00
if complexType.DerivationMethod <> dmNone then
interfaceItem.BaseName := complexType.BaseTypeName;
2008-03-09 20:36:27 +00:00
ASchema.AddItem(interfaceItem);
for elementIndex := 0 to Pred(complexType.ElementDefList.Count) do
ProcessChildElement(ASchema, complexType.ElementDefList[elementIndex], interfaceItem);
for attributeIndex := 0 to Pred(complexType.AttributeDefs.Count) do
ProcessAttribute(ASchema, complexType.AttributeDefs[attributeIndex], interfaceItem);
2008-03-09 20:36:27 +00:00
end;
end;
procedure TXMLDataBindingGenerator.GenerateSimpleTypeObjects(ASchema: TXMLDataBindingSchema);
var
schemaDef: IXMLSchemaDef;
simpleTypeIndex: Integer;
simpleType: IXMLSimpleTypeDef;
enumerationObject: TXMLDataBindingEnumeration;
baseType: IXMLTypeDef;
namespace: String;
simpleTypeAlias: TXMLDataBindingSimpleTypeAliasItem;
begin
schemaDef := ASchema.SchemaDef;
for simpleTypeIndex := 0 to Pred(schemaDef.SimpleTypes.Count) do
begin
simpleType := schemaDef.SimpleTypes[simpleTypeIndex];
if simpleType.Enumerations.Count > 0 then
begin
enumerationObject := TXMLDataBindingEnumeration.Create(Self, simpleType, simpleType.Enumerations, simpleType.Name, False);
ASchema.AddItem(enumerationObject);
end else if simpleType.DerivationMethod = sdmRestriction then
begin
baseType := simpleType.BaseType;
while Assigned(baseType.BaseType) do
baseType := baseType.BaseType;
if not baseType.IsComplex then
begin
if not VarIsNull(simpleType.SchemaDef.TargetNamespace) then
begin
namespace := simpleType.SchemaDef.TargetNamespace;
if namespace = Schemas[0].TargetNamespace then
namespace := '';
end;
simpleTypeAlias := TXMLDataBindingSimpleTypeAliasItem.Create(Self, baseType, simpleType.Name);
simpleTypeAlias.TargetNamespace := namespace;
ASchema.AddItem(simpleTypeAlias);
end;
end;
end;
end;
2008-04-14 19:28:57 +00:00
function TXMLDataBindingGenerator.CheckElementOccurance(AElement: IXMLElementDef; AOccurance: TXMLDataBindingOccurance): Boolean;
function CheckParent(const ANode: IXMLNode): Boolean;
var
compositor: IXMLElementCompositor;
begin
Result := False;
if Supports(ANode, IXMLElementCompositor, compositor) then
begin
case AOccurance of
2008-04-21 15:24:33 +00:00
boMinOccurs: Result := (compositor.MinOccurs = 0);
2008-04-14 19:28:57 +00:00
boMaxOccurs: Result := (compositor.MaxOccurs = MaxOccursUnbounded) or
(compositor.MaxOccurs > 1);
end;
if not Result then
Result := CheckParent(compositor.ParentNode);
end;
end;
begin
Result := False;
case AOccurance of
boMinOccurs: Result := (AElement.MinOccurs = 0);
boMaxOccurs: Result := (AElement.MaxOccurs = MaxOccursUnbounded) or
(AElement.MaxOccurs > 1);
end;
if not Result then
Result := CheckParent(AElement.ParentNode);
end;
function TXMLDataBindingGenerator.IsElementOptional(AElement: IXMLElementDef): Boolean;
begin
Result := CheckElementOccurance(AElement, boMinOccurs);
end;
function TXMLDataBindingGenerator.IsElementRepeating(AElement: IXMLElementDef): Boolean;
begin
Result := CheckElementOccurance(AElement, boMaxOccurs);
end;
function TXMLDataBindingGenerator.IsChoice(AElement: IXMLElementDef): Boolean;
var
compositor: IXMLElementCompositor;
begin
Result := False;
2008-04-21 15:24:33 +00:00
if Supports(AElement.ParentNode, IXMLElementCompositor, compositor) then
2008-04-14 19:28:57 +00:00
Result := (compositor.CompositorType = ctChoice) and
(compositor.ElementDefs.Count > 1);
end;
2008-03-09 20:36:27 +00:00
function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem;
var
2008-04-14 19:28:57 +00:00
attributeIndex: Integer;
2008-03-09 20:36:27 +00:00
enumerationObject: TXMLDataBindingEnumeration;
interfaceObject: TXMLDataBindingInterface;
2008-04-18 14:36:17 +00:00
complexAliasItem: TXMLDataBindingComplexTypeAliasItem;
simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem;
elementIndex: Integer;
simpleTypeDef: IXMLSimpleTypeDef;
2008-03-09 20:36:27 +00:00
begin
Result := nil;
interfaceObject := nil;
if Assigned(AElement.Ref) then
begin
{ Find reference. If not found, mark as "resolve later". }
Result := FindInterface(ASchema, AElement.Ref.Name, ifElement);
if not Assigned(Result) then
begin
Result := TXMLDataBindingUnresolvedItem.Create(Self, AElement, AElement.Ref.Name, ifElement, False);
2008-03-09 20:36:27 +00:00
ASchema.AddItem(Result);
end;
end else
begin
2008-04-18 14:36:17 +00:00
if not AElement.DataType.IsAnonymous then
2008-03-09 20:36:27 +00:00
begin
2008-04-18 14:36:17 +00:00
if AElement.DataType.IsComplex then
2008-03-09 20:36:27 +00:00
begin
2008-04-18 14:36:17 +00:00
{ Find data type. If not found, mark as "resolve later". }
Result := FindInterface(ASchema, AElement.DataTypeName, ifComplexType);
2008-04-18 14:36:17 +00:00
if not Assigned(Result) then
begin
Result := TXMLDataBindingUnresolvedItem.Create(Self, AElement, AElement.DataTypeName, ifComplexType, True);
2008-04-18 14:36:17 +00:00
ASchema.AddItem(Result);
end;
2008-04-18 14:36:17 +00:00
if AElement.IsGlobal then
begin
{ The element is global, but only references a complex type. Keep track
to properly resolve references to the element. }
complexAliasItem := TXMLDataBindingComplexTypeAliasItem.Create(Self, AElement, AElement.Name);
complexAliasItem.Item := Result;
ASchema.AddItem(complexAliasItem);
end;
end else if Supports(AElement.DataType, IXMLSimpleTypeDef, simpleTypeDef) then
begin
if simpleTypeDef.Enumerations.Count > 0 then
begin
{ References enumeration. }
Result := FindEnumeration(ASchema, AElement.DataTypeName, False);
if not Assigned(Result) then
begin
Result := TXMLDataBindingUnresolvedItem.Create(Self, AElement, AElement.DataTypeName, ifEnumeration, False);
ASchema.AddItem(Result);
end;
end else if simpleTypeDef.IsBuiltInType and AElement.IsGlobal then
begin
{ The element is global, but only references a simple type. }
simpleAliasItem := TXMLDataBindingSimpleTypeAliasItem.Create(Self, AElement, AElement.Name);
// #ToDo1 -oMvR: 17-4-2012: TargetNamespace!
simpleAliasItem.DataType := AElement.DataType;
ASchema.AddItem(simpleAliasItem);
2008-04-18 14:36:17 +00:00
Result := simpleAliasItem;
end;
end;
2008-03-09 20:36:27 +00:00
end;
if not Assigned(Result) then
begin
if AElement.DataType.Enumerations.Count > 0 then
begin
{ Enumeration }
enumerationObject := TXMLDataBindingEnumeration.Create(Self, AElement, AElement.DataType.Enumerations, AElement.Name, False);
2008-03-09 20:36:27 +00:00
ASchema.AddItem(enumerationObject);
Result := enumerationObject;
end else
2008-03-09 20:36:27 +00:00
begin
if AElement.DataType.IsComplex then
begin
{ Interface }
interfaceObject := TXMLDataBindingInterface.Create(Self, AElement, AElement.Name);
if Assigned(AElement.DataType.BaseType) then
interfaceObject.BaseName := AElement.DataType.BaseTypeName;
2008-03-09 20:36:27 +00:00
ASchema.AddItem(interfaceObject);
Result := interfaceObject;
end;
2008-03-09 20:36:27 +00:00
if Assigned(interfaceObject) then
begin
for elementIndex := 0 to Pred(AElement.ChildElements.Count) do
ProcessChildElement(ASchema, AElement.ChildElements[elementIndex], interfaceObject);
2008-04-14 19:28:57 +00:00
for attributeIndex := 0 to Pred(AElement.AttributeDefs.Count) do
ProcessAttribute(ASchema, AElement.AttributeDefs[attributeIndex], interfaceObject);
end else //if AElement.IsGlobal then
begin
{ Non-anonymous non-complex type. Assume somewhere in there is a
built-in type. }
Result := ProcessSimpleTypeReference(ASchema, AElement, AElement.DataType);
end;
2008-04-14 19:28:57 +00:00
end;
2008-03-09 20:36:27 +00:00
end;
end;
end;
function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef): TXMLDataBindingItem;
var
enumerationObject: TXMLDataBindingEnumeration;
interfaceObject: TXMLDataBindingInterface;
complexAliasItem: TXMLDataBindingComplexTypeAliasItem;
simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem;
simpleTypeDef: IXMLSimpleTypeDef;
begin
Result := nil;
if Assigned(AAttribute.Ref) then
begin
{ Find reference. If not found, mark as "resolve later". }
Result := FindInterface(ASchema, AAttribute.Ref.Name, ifElement);
if not Assigned(Result) then
begin
Result := TXMLDataBindingUnresolvedItem.Create(Self, AAttribute, AAttribute.Ref.Name, ifElement, True);
ASchema.AddItem(Result);
end;
end else
begin
if not AAttribute.DataType.IsAnonymous then
begin
if AAttribute.DataType.IsComplex then
begin
{ Find data type. If not found, mark as "resolve later". }
Result := FindInterface(ASchema, AAttribute.DataTypeName, ifComplexType);
if not Assigned(Result) then
begin
Result := TXMLDataBindingUnresolvedItem.Create(Self, AAttribute, AAttribute.DataTypeName, ifComplexType, True);
ASchema.AddItem(Result);
end;
if AAttribute.IsGlobal then
begin
{ The element is global, but only references a complex type. Keep track
to properly resolve references to the element. }
complexAliasItem := TXMLDataBindingComplexTypeAliasItem.Create(Self, AAttribute, AAttribute.Name);
complexAliasItem.Item := Result;
ASchema.AddItem(complexAliasItem);
end;
end else if Supports(AAttribute.DataType, IXMLSimpleTypeDef, simpleTypeDef) then
begin
if simpleTypeDef.Enumerations.Count > 0 then
begin
{ References enumeration. }
Result := FindEnumeration(ASchema, AAttribute.DataTypeName, True);
if not Assigned(Result) then
begin
Result := TXMLDataBindingUnresolvedItem.Create(Self, AAttribute, AAttribute.DataTypeName, ifEnumeration, True);
ASchema.AddItem(Result);
end;
end else if simpleTypeDef.IsBuiltInType and AAttribute.IsGlobal then
begin
{ The element is global, but only references a simple type. }
simpleAliasItem := TXMLDataBindingSimpleTypeAliasItem.Create(Self, AAttribute, AAttribute.Name);
// #ToDo1 -oMvR: 17-4-2012: TargetNamespace!
simpleAliasItem.DataType := AAttribute.DataType;
ASchema.AddItem(simpleAliasItem);
Result := simpleAliasItem;
end;
end;
end;
if not Assigned(Result) then
begin
if AAttribute.DataType.Enumerations.Count > 0 then
begin
{ Enumeration }
enumerationObject := TXMLDataBindingEnumeration.Create(Self, AAttribute, AAttribute.DataType.Enumerations, AAttribute.Name, True);
ASchema.AddItem(enumerationObject);
Result := enumerationObject;
end else if AAttribute.DataType.IsComplex then
begin
{ Interface }
interfaceObject := TXMLDataBindingInterface.Create(Self, AAttribute, AAttribute.Name);
if Assigned(AAttribute.DataType.BaseType) then
interfaceObject.BaseName := AAttribute.DataType.BaseTypeName;
ASchema.AddItem(interfaceObject);
Result := interfaceObject;
end else //if AAttribute.IsGlobal then
begin
{ Non-anonymous non-complex type. Assume somewhere in there is a
built-in type. }
Result := ProcessSimpleTypeReference(ASchema, AAttribute, AAttribute.DataType);
end;
end;
end;
end;
2008-03-09 20:36:27 +00:00
procedure TXMLDataBindingGenerator.ProcessChildElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef; AInterface: TXMLDataBindingInterface);
var
2008-04-21 15:24:33 +00:00
actualElement: IXMLElementDef;
2008-03-09 20:36:27 +00:00
propertyType: TXMLDataBindingItem;
propertyItem: TXMLDataBindingProperty;
namespace: string;
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
propertyType := ProcessElement(ASchema, AElement);
2008-03-09 20:36:27 +00:00
if Assigned(AInterface) then
begin
if Assigned(propertyType) then
2008-04-14 19:28:57 +00:00
propertyItem := TXMLDataBindingItemProperty.Create(Self, AElement,
AElement.Name,
propertyType)
else
2008-04-14 19:28:57 +00:00
propertyItem := TXMLDataBindingSimpleProperty.Create(Self, AElement,
AElement.Name,
AElement.DataType);
if not VarIsNull(AElement.SchemaDef.TargetNamespace) then
begin
namespace := AElement.SchemaDef.TargetNamespace;
if namespace <> Schemas[0].TargetNamespace then
propertyItem.TargetNamespace := namespace;
end;
2008-04-14 19:28:57 +00:00
propertyItem.IsOptional := IsElementOptional(AElement) or
IsChoice(AElement);
propertyItem.IsRepeating := IsElementRepeating(AElement);
2008-04-21 15:24:33 +00:00
actualElement := AElement;
while Assigned(actualElement) and Assigned(actualElement.Ref) do
actualElement := actualElement.Ref;
if AElement.HasAttribute(AttributeNillable) then
propertyItem.IsNillable := StrToBoolDef(AElement.Attributes[AttributeNillable], False)
else if actualElement.HasAttribute(AttributeNillable) then
propertyItem.IsNillable := StrToBoolDef(actualElement.Attributes[AttributeNillable], False);
2008-04-14 19:28:57 +00:00
AInterface.AddProperty(propertyItem);
end;
2008-04-14 19:28:57 +00:00
end;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
procedure TXMLDataBindingGenerator.ProcessAttribute(ASchema: TXMLDataBindingSchema; AAttribute: IXMLAttributeDef; AInterface: TXMLDataBindingInterface);
var
propertyItem: TXMLDataBindingProperty;
propertyType: TXMLDataBindingItem;
namespace: string;
2008-03-09 20:36:27 +00:00
2008-04-14 19:28:57 +00:00
begin
propertyType := ProcessElement(ASchema, AAttribute);
if Assigned(propertyType) then
propertyItem := TXMLDataBindingItemProperty.Create(Self, AAttribute,
2008-04-14 19:28:57 +00:00
AAttribute.Name,
propertyType)
else
propertyItem := TXMLDataBindingSimpleProperty.Create(Self, AAttribute,
AAttribute.Name,
AAttribute.DataType);
2008-04-14 19:28:57 +00:00
if not VarIsNull(AAttribute.SchemaDef.TargetNamespace) then
begin
namespace := AAttribute.SchemaDef.TargetNamespace;
if namespace <> ASchema.TargetNamespace then
propertyItem.TargetNamespace := namespace;
end;
propertyItem.IsOptional := (AAttribute.Use <> UseRequired);
2008-04-14 19:28:57 +00:00
propertyItem.IsAttribute := True;
AInterface.AddProperty(propertyItem);
2008-03-09 20:36:27 +00:00
end;
function TXMLDataBindingGenerator.ProcessSimpleTypeReference(ASchema: TXMLDataBindingSchema; AItem: IXMLSchemaItem; ADataType: IXMLTypeDef): TXMLDataBindingItem;
var
typeDef: IXMLTypeDef;
simpleTypeDef: IXMLSimpleTypeDef;
simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem;
begin
Result := nil;
{ This code is a fine bit of trial-and-error. It works for the files
I've seen so far, but has been modified enough times to say for sure
there'll be another unsupported way of referencing simple types. }
typeDef := ADataType;
while Assigned(typeDef) do
begin
if Supports(typeDef, IXMLSimpleTypeDef, simpleTypeDef) then
begin
if simpleTypeDef.IsBuiltInType then
begin
{ The element is global, but only references a simple type. }
simpleAliasItem := TXMLDataBindingSimpleTypeAliasItem.Create(Self, AItem, AItem.Name);
simpleAliasItem.DataType := typeDef;
ASchema.AddItem(simpleAliasItem);
Result := simpleAliasItem;
Break;
end else
begin
case simpleTypeDef.DerivationMethod of
sdmRestriction:
typeDef := typeDef.BaseType;
sdmUnion:
begin
simpleAliasItem := TXMLDataBindingSimpleTypeAliasItem.Create(Self, AItem, AItem.Name);
simpleAliasItem.DataType := typeDef;
// #ToDo1 -oMvR: set type "union"
ASchema.AddItem(simpleAliasItem);
end
else
typeDef := nil;
end;
end;
end;
end;
// if not VarIsNull(typeDef.SchemaDef.TargetNamespace) then
// begin
// namespace := typeDef.SchemaDef.TargetNamespace;
// if namespace <> ASchema.TargetNamespace then
// propertyItem.TargetNamespace := namespace;
// end;
end;
2008-03-09 20:36:27 +00:00
function TXMLDataBindingGenerator.IterateSchemaItems(ASchema: TXMLDataBindingSchema; AIterateProc: TXMLDataBindingIterateItemsProc; AData: Pointer): TXMLDataBindingItem;
var
abort: Boolean;
itemIndex: Integer;
schemaItem: TXMLDataBindingItem;
includeIndex: Integer;
begin
Result := nil;
abort := False;
for itemIndex := 0 to Pred(ASchema.ItemCount) do
begin
schemaItem := ASchema.Items[itemIndex];
AIterateProc(schemaItem, AData, abort);
if abort then
begin
Result := schemaItem;
Break;
end;
end;
if not Assigned(Result) then
begin
for includeIndex := 0 to Pred(ASchema.IncludeCount) do
begin
Result := IterateSchemaItems(ASchema.Includes[includeIndex], AIterateProc, AData);
if Assigned(Result) then
break;
end;
end;
end;
type
PFindInterfaceInfo = ^TFindInterfaceInfo;
TFindInterfaceInfo = record
InterfaceType: TXMLDataBindingInterfaceType;
Name: String;
end;
PFindEnumerationInfo = ^TFindEnumerationInfo;
TFindEnumerationInfo = record
Attribute: Boolean;
Name: String;
end;
2008-03-09 20:36:27 +00:00
procedure TXMLDataBindingGenerator.FindInterfaceProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean);
var
findInfo: PFindInterfaceInfo;
2008-03-09 20:36:27 +00:00
begin
AAbort := False;
2008-03-09 20:36:27 +00:00
findInfo := PFindInterfaceInfo(AData);
if AItem.Name = findInfo^.Name then
begin
case AItem.ItemType of
itInterface:
AAbort := (TXMLDataBindingInterface(AItem).InterfaceType = findInfo^.InterfaceType);
2008-04-18 14:36:17 +00:00
itComplexTypeAlias,
itSimpleTypeAlias:
AAbort := (findInfo^.InterfaceType = ifElement);
end;
end;
2008-03-09 20:36:27 +00:00
end;
function TXMLDataBindingGenerator.FindInterface(ASchema: TXMLDataBindingSchema; const AName: String; AType: TXMLDataBindingInterfaceType): TXMLDataBindingInterface;
var
findInfo: TFindInterfaceInfo;
begin
findInfo.InterfaceType := AType;
findInfo.Name := AName;
2008-04-14 19:28:57 +00:00
Result := TXMLDataBindingInterface(IterateSchemaItems(ASchema, FindInterfaceProc, @findInfo));
2008-03-09 20:36:27 +00:00
end;
procedure TXMLDataBindingGenerator.FindEnumerationProc(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean);
var
findInfo: PFindEnumerationInfo;
2008-03-09 20:36:27 +00:00
begin
findInfo := PFindEnumerationInfo(AData);
AAbort := (AItem.ItemType = itEnumeration) and
(AItem.Name = findInfo^.Name) and
(TXMLDataBindingEnumeration(AItem).IsAttribute = findInfo^.Attribute);
2008-03-09 20:36:27 +00:00
end;
function TXMLDataBindingGenerator.FindEnumeration(ASchema: TXMLDataBindingSchema; const AName: String; AAttribute: Boolean): TXMLDataBindingEnumeration;
var
findInfo: TFindEnumerationInfo;
2008-03-09 20:36:27 +00:00
begin
findInfo.Attribute := AAttribute;
findInfo.Name := AName;
Result := TXMLDataBindingEnumeration(IterateSchemaItems(ASchema, FindEnumerationProc, @findInfo));
2008-03-09 20:36:27 +00:00
end;
2008-04-14 19:28:57 +00:00
procedure TXMLDataBindingGenerator.ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem);
var
2008-04-14 19:28:57 +00:00
schemaIndex: Integer;
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
for schemaIndex := Pred(SchemaCount) downto 0 do
Schemas[schemaIndex].ReplaceItem(AOldItem, ANewItem);
2008-03-09 20:36:27 +00:00
end;
procedure TXMLDataBindingGenerator.ResolveSchema(ASchema: TXMLDataBindingSchema);
var
itemIndex: Integer;
item: TXMLDataBindingItem;
interfaceItem: TXMLDataBindingInterface;
begin
2008-04-14 19:28:57 +00:00
for itemIndex := Pred(ASchema.ItemCount) downto 0 do
2008-03-09 20:36:27 +00:00
begin
item := ASchema.Items[itemIndex];
case item.ItemType of
itInterface:
begin
{ Resolve base interface }
interfaceItem := TXMLDataBindingInterface(item);
if (not Assigned(interfaceItem.BaseItem)) and
(Length(interfaceItem.BaseName) > 0) then
2008-03-09 20:36:27 +00:00
interfaceItem.BaseItem := FindInterface(ASchema, interfaceItem.BaseName, ifComplexType);
end;
2008-04-14 19:28:57 +00:00
itUnresolved:
begin
ResolveItem(ASchema, TXMLDataBindingUnresolvedItem(item));
FreeAndNil(item);
end;
2008-04-14 19:28:57 +00:00
end;
end;
end;
procedure TXMLDataBindingGenerator.ResolveAlias(ASchema: TXMLDataBindingSchema);
var
2008-04-18 14:36:17 +00:00
itemIndex: Integer;
item: TXMLDataBindingItem;
complexAliasItem: TXMLDataBindingComplexTypeAliasItem;
simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem;
interfaceItem: TXMLDataBindingInterface;
2008-04-18 14:36:17 +00:00
2008-04-14 19:28:57 +00:00
begin
for itemIndex := Pred(ASchema.ItemCount) downto 0 do
begin
item := ASchema.Items[itemIndex];
2008-04-18 14:36:17 +00:00
case item.ItemType of
itComplexTypeAlias:
begin
{ Replace alias element with the actual complex type }
complexAliasItem := TXMLDataBindingComplexTypeAliasItem(item);
if Assigned(complexAliasItem.Item) then
begin
// (MvR) 27-8-2008: instead, we allow the generation of an alias in
// code, so it can be used as a document element
// ReplaceItem(complexAliasItem, complexAliasItem.Item);
interfaceItem := TXMLDataBindingInterface.Create(Self, complexAliasItem.SchemaItem, complexAliasItem.Name);
interfaceItem.BaseItem := (complexAliasItem.Item as TXMLDataBindingInterface);
interfaceItem.BaseName := complexAliasItem.Item.Name;
ASchema.AddItem(interfaceItem);
ReplaceItem(complexAliasItem, interfaceItem);
2008-04-18 14:36:17 +00:00
FreeAndNil(complexAliasItem);
end;
end;
itSimpleTypeAlias:
begin
{ Remove the alias element - TXMLDataBindingInterfaceItem.ReplaceItem
will take care of fixing it's properties. }
simpleAliasItem := TXMLDataBindingSimpleTypeAliasItem(item);
ReplaceItem(simpleAliasItem, nil);
FreeAndNil(simpleAliasItem);
end;
2008-03-09 20:36:27 +00:00
end;
end;
end;
2008-04-14 19:28:57 +00:00
procedure TXMLDataBindingGenerator.ResolveItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingUnresolvedItem);
var
referenceItem: TXMLDataBindingItem;
begin
2008-04-14 19:28:57 +00:00
if not Assigned(AItem) then
Exit;
if AItem.InterfaceType = ifEnumeration then
referenceItem := FindEnumeration(ASchema, AItem.Name, AItem.IsAttribute)
else
begin
referenceItem := FindInterface(ASchema, AItem.Name, AItem.InterfaceType);
if (not Assigned(referenceItem)) and
(AItem.InterfaceType = ifElement) then
referenceItem := FindEnumeration(ASchema, AItem.Name, AItem.IsAttribute);
end;
2008-04-14 19:28:57 +00:00
if Assigned(referenceItem) then
ReplaceItem(AItem, referenceItem);
end;
procedure TXMLDataBindingGenerator.ResolveNameConflicts;
2008-03-09 20:36:27 +00:00
var
itemNames: TX2SOHash;
procedure AddItem(AItem: TXMLDataBindingItem);
var
hashName: String;
items: TObjectList;
begin
{ LowerCase because XML is case-sensitive, but Delphi isn't. }
hashName := LowerCase(AItem.Name);
2008-04-14 19:28:57 +00:00
2008-03-09 20:36:27 +00:00
if not itemNames.Exists(hashName) then
begin
items := TObjectList.Create(False);
itemNames[hashName] := items;
end else
items := TObjectList(itemNames[hashName]);
items.Add(AItem);
end;
function ResolveItemNameConflict(AItem: TXMLDataBindingItem; ADepth: Integer; out ANewName: String): Boolean;
var
currentDepth: Integer;
parentNode: IXMLNode;
schemaItem: IXMLSchemaItem;
begin
Result := False;
currentDepth := 0;
parentNode := AItem.SchemaItem;
ANewName := AItem.Name;
while Assigned(parentNode) do
begin
parentNode := parentNode.ParentNode;
if Assigned(parentNode) and
Supports(parentNode, IXMLSchemaItem, schemaItem) and
(Length(schemaItem.Name) > 0) then
begin
ANewName := schemaItem.Name + ANewName;
Inc(currentDepth);
if currentDepth = ADepth then
begin
Result := True;
break;
end;
end;
end;
end;
var
schemaIndex: Integer;
schema: TXMLDataBindingSchema;
itemIndex: Integer;
items: TObjectList;
item: TXMLDataBindingItem;
depth: Integer;
newName: String;
resolved: Boolean;
begin
itemNames := TX2SOHash.Create(True);
try
{ Gather names }
for schemaIndex := 0 to Pred(SchemaCount) do
begin
schema := Schemas[schemaIndex];
for itemIndex := 0 to Pred(schema.ItemCount) do
begin
item := schema.Items[itemIndex];
2008-04-14 19:28:57 +00:00
if item.ItemType in [itInterface, itEnumeration] then
2008-03-09 20:36:27 +00:00
AddItem(item);
end;
end;
{ Find conflicts }
itemNames.First;
2008-03-09 20:36:27 +00:00
while itemNames.Next do
2008-03-09 20:36:27 +00:00
begin
items := TObjectList(itemNames.CurrentValue);
if items.Count > 1 then
begin
{ Attempt to rename items }
for itemIndex := Pred(items.Count) downto 0 do
begin
item := TXMLDataBindingItem(items[itemIndex]);
newName := item.Name;
resolved := False;
depth := 1;
while ResolveItemNameConflict(item, depth, newName) do
begin
if not itemNames.Exists(newName) then
begin
resolved := True;
break;
end else
Inc(depth);
end;
{ test }
if not resolved then
begin
newName := newName + IntToStr(Succ(itemIndex));
resolved := True;
end;
2008-03-09 20:36:27 +00:00
if resolved then
begin
items.Delete(itemIndex);
item.SetName(newName);
AddItem(item);
end;
end;
end;
end;
finally
FreeAndNil(itemNames);
end;
end;
2008-04-14 19:28:57 +00:00
procedure TXMLDataBindingGenerator.PostProcessSchema(ASchema: TXMLDataBindingSchema);
2008-03-09 20:36:27 +00:00
var
itemIndex: Integer;
begin
2008-04-14 19:28:57 +00:00
for itemIndex := Pred(ASchema.ItemCount) downto 0 do
PostProcessItem(ASchema, ASchema.Items[itemIndex]);
2008-03-09 20:36:27 +00:00
end;
2008-04-14 19:28:57 +00:00
procedure TXMLDataBindingGenerator.PostProcessItem(ASchema: TXMLDataBindingSchema; AItem: TXMLDataBindingItem);
2008-03-09 20:36:27 +00:00
var
2008-04-14 19:28:57 +00:00
collectionItem: TXMLDataBindingInterface;
collectionName: string;
enumerationItem: TXMLDataBindingEnumeration;
interfaceItem: TXMLDataBindingInterface;
memberIndex: Integer;
propertyIndex: Integer;
propertyItem: TXMLDataBindingProperty;
repeatingItems: TObjectList;
typedSchemaItem: IXMLTypedSchemaItem;
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
{ Translate name }
AItem.TranslatedName := TranslateItemName(AItem);
{ Process members }
case AItem.ItemType of
itInterface:
begin
interfaceItem := TXMLDataBindingInterface(AItem);
if (not Assigned(interfaceItem.BaseItem)) and
(Length(interfaceItem.BaseName) > 0) then
begin
{ Assume this is a reference to a simple type }
if Supports(interfaceItem.SchemaItem, IXMLTypedSchemaItem, typedSchemaItem) then
begin
propertyItem := TXMLDataBindingSimpleProperty.Create(Self, interfaceItem.SchemaItem, 'Value',
typedSchemaItem.DataType.BaseType);
propertyItem.IsNodeValue := True;
interfaceItem.AddProperty(propertyItem);
end;
end;
for propertyIndex := 0 to Pred(interfaceItem.PropertyCount) do
PostProcessItem(ASchema, interfaceItem.Properties[propertyIndex]);
end;
itEnumeration:
begin
enumerationItem := TXMLDataBindingEnumeration(AItem);
for memberIndex := 0 to Pred(enumerationItem.MemberCount) do
PostProcessItem(ASchema, enumerationItem.Members[memberIndex]);
end;
end;
2008-04-14 19:28:57 +00:00
{ Extract collections }
if AItem.ItemType = itInterface then
begin
interfaceItem := TXMLDataBindingInterface(AItem);
interfaceItem.CollectionItem := nil;
repeatingItems := TObjectList.Create(False);
try
for propertyIndex := 0 to Pred(interfaceItem.PropertyCount) do
if interfaceItem.Properties[propertyIndex].IsRepeating then
repeatingItems.Add(interfaceItem.Properties[propertyIndex]);
if repeatingItems.Count > 0 then
begin
if (repeatingItems.Count = 1) and
(not Assigned(interfaceItem.BaseItem)) then
2008-04-14 19:28:57 +00:00
begin
{ Single repeating child, the item itself is a collection parent }
interfaceItem.CollectionItem := TXMLDataBindingProperty(repeatingItems[0]);
end else
begin
{ Multiple repeating children or this interface is a descendant,
create intermediate collections for each }
2008-04-14 19:28:57 +00:00
for propertyIndex := 0 to Pred(repeatingItems.Count) do
begin
propertyItem := TXMLDataBindingProperty(repeatingItems[propertyIndex]);
// #ToDo1 (MvR) 7-4-2008: check if an item with the "List" postfix
// exists in the schema, as it could cause
// conflicts.
// #ToDo1 (MvR) 30-7-2008: temporary implementation; have to check
// for proper functioning later.
collectionItem := FindInterface(ASchema, propertyItem.TranslatedName + CollectionPostfix, ifElement);
if not Assigned(collectionItem) then
begin
case propertyItem.PropertyType of
ptSimple: collectionName := propertyItem.TranslatedName + CollectionPostfix;
ptItem: collectionName := propertyItem.TranslatedName + CollectionPostfix;
end;
collectionItem := TXMLDataBindingInterface.Create(Self, propertyItem.SchemaItem, collectionName);
collectionItem.CollectionItem := propertyItem;
ASchema.InsertItem(collectionItem, interfaceItem);
2008-04-14 19:28:57 +00:00
end;
propertyItem.Collection := collectionItem;
2008-04-14 19:28:57 +00:00
end;
end;
end;
finally
FreeAndNil(repeatingItems);
end;
end;
2008-03-09 20:36:27 +00:00
end;
function TXMLDataBindingGenerator.TranslateItemName(AItem: TXMLDataBindingItem): String;
begin
Result := AItem.Name;
end;
function TXMLDataBindingGenerator.GetSchemaCount: Integer;
2008-03-09 20:36:27 +00:00
begin
Result := FSchemas.Count;
end;
function TXMLDataBindingGenerator.GetSchemas(Index: Integer): TXMLDataBindingSchema;
begin
Result := TXMLDataBindingSchema(FSchemas[Index]);
end;
2008-04-14 19:28:57 +00:00
{ TXMLDataBindingGeneratorItem }
constructor TXMLDataBindingGeneratorItem.Create(AOwner: TXMLDataBindingGenerator);
begin
inherited Create;
2008-04-14 19:28:57 +00:00
FOwner := AOwner;
end;
procedure TXMLDataBindingGeneratorItem.ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem);
begin
end;
2008-03-09 20:36:27 +00:00
{ TXMLDataBindingSchema }
2008-04-14 19:28:57 +00:00
constructor TXMLDataBindingSchema.Create(AOwner: TXMLDataBindingGenerator);
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
inherited Create(AOwner);
2008-03-09 20:36:27 +00:00
FIncludes := TObjectList.Create(False);
FItems := TObjectList.Create(True);
end;
destructor TXMLDataBindingSchema.Destroy;
2008-03-09 20:36:27 +00:00
begin
FreeAndNil(FItems);
FreeAndNil(FIncludes);
inherited;
end;
2008-04-14 19:28:57 +00:00
procedure TXMLDataBindingSchema.ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem);
var
itemIndex: Integer;
begin
inherited;
for itemIndex := Pred(ItemCount) downto 0 do
if Items[itemIndex] = AOldItem then
FItems.Extract(AOldItem)
else
Items[itemIndex].ReplaceItem(AOldItem, ANewItem);
end;
2008-03-09 20:36:27 +00:00
procedure TXMLDataBindingSchema.AddInclude(ASchema: TXMLDataBindingSchema);
begin
if FIncludes.IndexOf(ASchema) = -1 then
FIncludes.Add(ASchema);
end;
procedure TXMLDataBindingSchema.AddItem(AItem: TXMLDataBindingItem);
begin
if FItems.IndexOf(AItem) = -1 then
2008-04-14 19:28:57 +00:00
begin
2008-03-09 20:36:27 +00:00
FItems.Add(AItem);
2008-04-14 19:28:57 +00:00
AItem.Schema := Self;
end;
end;
procedure TXMLDataBindingSchema.InsertItem(AItem, AAfter: TXMLDataBindingItem);
var
itemIndex: Integer;
begin
if FItems.IndexOf(AItem) = -1 then
begin
itemIndex := FItems.IndexOf(AAfter);
if itemIndex > -1 then
FItems.Insert(Succ(itemIndex), AItem)
else
FItems.Add(AItem);
AItem.Schema := Self;
end;
2008-03-09 20:36:27 +00:00
end;
function TXMLDataBindingSchema.GetIncludeCount: Integer;
2008-03-09 20:36:27 +00:00
begin
Result := FIncludes.Count;
end;
function TXMLDataBindingSchema.GetIncludes(Index: Integer): TXMLDataBindingSchema;
begin
Result := TXMLDataBindingSchema(FIncludes[Index]);
end;
function TXMLDataBindingSchema.GetItemCount: Integer;
2008-03-09 20:36:27 +00:00
begin
Result := FItems.Count;
end;
function TXMLDataBindingSchema.GetItems(Index: Integer): TXMLDataBindingItem;
begin
Result := TXMLDataBindingItem(FItems[Index]);
end;
function TXMLDataBindingSchema.GetTargetNamespace: String;
begin
Result := '';
if Assigned(FSchemaDef) and (not VarIsNull(FSchemaDef.TargetNamespace)) then
Result := FSchemaDef.TargetNamespace;
end;
2008-03-09 20:36:27 +00:00
{ TXMLDataBindingItem }
2008-04-14 19:28:57 +00:00
constructor TXMLDataBindingItem.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String);
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
inherited Create(AOwner);
2008-03-09 20:36:27 +00:00
FName := AName;
FSchemaItem := ASchemaItem;
FTranslatedName := AName;
end;
function TXMLDataBindingItem.GetDocumentation: String;
2008-03-09 20:36:27 +00:00
var
documentationIndex: Integer;
begin
Result := '';
if HasDocumentation then
begin
for documentationIndex := 0 to Pred(SchemaItem.Documentation.Count) do
Result := Result + SchemaItem.Documentation[documentationIndex].Text + #13#10;
Result := Trim(Result);
end;
end;
function TXMLDataBindingItem.GetHasDocumentation: Boolean;
2008-03-09 20:36:27 +00:00
begin
Result := Assigned(SchemaItem) and
(SchemaItem.Documentation.Count > 0);
end;
2008-04-14 19:28:57 +00:00
function TXMLDataBindingItem.GetIsCollection: Boolean;
2008-04-14 19:28:57 +00:00
begin
Result := Assigned(FCollectionItem);
end;
2008-03-09 20:36:27 +00:00
procedure TXMLDataBindingItem.SetName(const Value: String);
begin
FName := Value;
end;
{ TXMLDataBindingInterface }
2008-04-14 19:28:57 +00:00
constructor TXMLDataBindingInterface.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String);
var
elementDef: IXMLElementDef;
compositor: IXMLElementCompositor;
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
inherited Create(AOwner, ASchemaItem, AName);
2008-03-09 20:36:27 +00:00
FProperties := TObjectList.Create(True);
FInterfaceType := GetInterfaceType(SchemaItem);
FIsSequence := False;
if Supports(ASchemaItem, IXMLElementDef, elementDef) then
begin
{ To access the compositor, we need to go through a ChildElement's ParentNode.
Tried but did not work:
ASchemaItem as IXMLElementCompositor
ASchemaItem.ChildNodes[0] as IXMLElementCompositor
}
if elementDef.ChildElements.Count > 0 then
begin
if Supports(elementDef.ChildElements[0].ParentNode, IXMLElementCompositor, compositor) then
FIsSequence := (compositor.CompositorType = ctSequence);
end;
end;
2008-03-09 20:36:27 +00:00
end;
destructor TXMLDataBindingInterface.Destroy;
begin
FreeAndNil(FProperties);
inherited;
end;
2008-04-14 19:28:57 +00:00
procedure TXMLDataBindingInterface.ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem);
var
2008-04-18 14:36:17 +00:00
propertyIndex: Integer;
propertyItem: TXMLDataBindingProperty;
itemProperty: TXMLDataBindingItemProperty;
simpleProperty: TXMLDataBindingSimpleProperty;
2008-04-14 19:28:57 +00:00
begin
inherited;
// #ToDo1 -oMvR: replacing a simpletypealias with nil doesn't quite work. not sure yet why.
2008-04-14 19:28:57 +00:00
for propertyIndex := Pred(PropertyCount) downto 0 do
2008-04-18 14:36:17 +00:00
begin
propertyItem := Properties[propertyIndex];
if propertyItem = AOldItem then
FProperties.Extract(AOldItem)
else
begin
if (AOldItem.ItemType = itSimpleTypeAlias) and
(propertyItem.PropertyType = ptItem) then
begin
itemProperty := TXMLDataBindingItemProperty(propertyItem);
if itemProperty.Item = AOldItem then
begin
{ Replace item property with simple property }
2008-04-21 15:24:33 +00:00
simpleProperty := TXMLDataBindingSimpleProperty.CreateFromAlias(Owner, itemProperty, TXMLDataBindingSimpleTypeAliasItem(AOldItem).DataType);
2008-04-18 14:36:17 +00:00
{ FProperties owns itemProperty and will free it }
FProperties[propertyIndex] := simpleProperty;
end else
Properties[propertyIndex].ReplaceItem(AOldItem, ANewItem);
end else
Properties[propertyIndex].ReplaceItem(AOldItem, ANewItem);
end;
end;
2008-04-14 19:28:57 +00:00
end;
2008-03-09 20:36:27 +00:00
procedure TXMLDataBindingInterface.AddProperty(AProperty: TXMLDataBindingProperty);
begin
FProperties.Add(AProperty);
end;
function TXMLDataBindingInterface.GetCanValidate: Boolean;
var
propertyIndex: Integer;
elementCount: Integer;
requiredCount: Integer;
propertyItem: TXMLDataBindingProperty;
begin
Result := False;
elementCount := 0;
requiredCount := 0;
for propertyIndex := 0 to Pred(PropertyCount) do
begin
propertyItem := Properties[propertyIndex];
if propertyItem.IsAttribute then
begin
if not propertyItem.IsOptional then
Inc(requiredCount);
end else
begin
Inc(elementCount);
if not propertyItem.IsOptional then
Inc(requiredCount);
end;
end;
{ If there's a required element or attribute,
we can validate their presence. }
if requiredCount > 0 then
Result := True
{ If our children are a sequence and there's at least two elements,
we can validate their order. }
else if IsSequence and (elementCount > 1) then
Result := True;
end;
function TXMLDataBindingInterface.GetItemType: TXMLDataBindingItemType;
2008-03-09 20:36:27 +00:00
begin
Result := itInterface;
end;
function TXMLDataBindingInterface.GetPropertyCount: Integer;
2008-03-09 20:36:27 +00:00
begin
Result := FProperties.Count;
end;
function TXMLDataBindingInterface.GetProperties(Index: Integer): TXMLDataBindingProperty;
begin
Result := TXMLDataBindingProperty(FProperties[Index]);
end;
{ TXMLDataBindingEnumerationMember }
2008-04-14 19:28:57 +00:00
constructor TXMLDataBindingEnumerationMember.Create(AOwner: TXMLDataBindingGenerator; AEnumeration: TXMLDataBindingEnumeration; const AName: String);
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
inherited Create(AOwner, nil, AName);
2008-03-09 20:36:27 +00:00
FEnumeration := AEnumeration;
end;
function TXMLDataBindingEnumerationMember.GetItemType: TXMLDataBindingItemType;
2008-03-09 20:36:27 +00:00
begin
Result := itEnumerationMember;
end;
{ TXMLDataBindingEnumeration }
constructor TXMLDataBindingEnumeration.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; AEnumerations: IXMLEnumerationCollection; const AName: String; AIsAttribute: Boolean);
2008-03-09 20:36:27 +00:00
var
memberIndex: Integer;
begin
2008-04-14 19:28:57 +00:00
inherited Create(AOwner, ASchemaItem, AName);
2008-03-09 20:36:27 +00:00
FMembers := TObjectList.Create;
FIsAttribute := AIsAttribute;
2008-03-09 20:36:27 +00:00
for memberIndex := 0 to Pred(AEnumerations.Count) do
FMembers.Add(TXMLDataBindingEnumerationMember.Create(Owner, Self, AEnumerations.Items[memberIndex].Value));
2008-03-09 20:36:27 +00:00
end;
destructor TXMLDataBindingEnumeration.Destroy;
2008-03-09 20:36:27 +00:00
begin
FreeAndNil(FMembers);
inherited;
end;
function TXMLDataBindingEnumeration.GetItemType: TXMLDataBindingItemType;
2008-03-09 20:36:27 +00:00
begin
Result := itEnumeration;
end;
function TXMLDataBindingEnumeration.GetMemberCount: Integer;
2008-03-09 20:36:27 +00:00
begin
Result := FMembers.Count;
end;
function TXMLDataBindingEnumeration.GetMembers(Index: Integer): TXMLDataBindingEnumerationMember;
begin
Result := TXMLDataBindingEnumerationMember(FMembers[Index]);
end;
{ TXMLDataBindingProperty }
function TXMLDataBindingProperty.GetHasTargetNamespace: Boolean;
begin
Result := (Length(TargetNamespace) > 0);
end;
function TXMLDataBindingProperty.GetItemType: TXMLDataBindingItemType;
2008-03-09 20:36:27 +00:00
begin
Result := itProperty;
end;
{ TXMLDataBindingSimpleProperty }
2008-04-14 19:28:57 +00:00
constructor TXMLDataBindingSimpleProperty.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; ADataType: IXMLTypeDef);
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
inherited Create(AOwner, ASchemaItem, AName);
2008-03-09 20:36:27 +00:00
FDataType := ADataType;
end;
2008-04-21 15:24:33 +00:00
constructor TXMLDataBindingSimpleProperty.CreateFromAlias(AOwner: TXMLDataBindingGenerator; AProperty: TXMLDataBindingItemProperty; ADataType: IXMLTypeDef);
begin
Create(AOwner, AProperty.SchemaItem, AProperty.Name, ADataType);
TargetNamespace := AProperty.TargetNamespace;
2008-04-21 15:24:33 +00:00
IsAttribute := AProperty.IsAttribute;
IsOptional := AProperty.IsOptional;
IsNillable := AProperty.IsNillable;
IsRepeating := AProperty.IsRepeating;
end;
function TXMLDataBindingSimpleProperty.GetIsReadOnly: Boolean;
2008-03-09 20:36:27 +00:00
begin
Result := False;
end;
function TXMLDataBindingSimpleProperty.GetPropertyType: TXMLDataBindingPropertyType;
2008-03-09 20:36:27 +00:00
begin
Result := ptSimple;
end;
{ TXMLDataBindingItemProperty }
2008-04-14 19:28:57 +00:00
constructor TXMLDataBindingItemProperty.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AItem: TXMLDataBindingItem);
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
inherited Create(AOwner, ASchemaItem, AName);
2008-03-09 20:36:27 +00:00
FItem := AItem;
end;
2008-04-14 19:28:57 +00:00
procedure TXMLDataBindingItemProperty.ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem);
begin
inherited;
if FItem = AOldItem then
FItem := ANewItem;
end;
function TXMLDataBindingItemProperty.GetIsReadOnly: Boolean;
2008-03-09 20:36:27 +00:00
begin
Result := Assigned(Item) and (Item.ItemType <> itEnumeration);
end;
function TXMLDataBindingItemProperty.GetPropertyType: TXMLDataBindingPropertyType;
2008-03-09 20:36:27 +00:00
begin
Result := ptItem;
end;
2008-04-14 19:28:57 +00:00
{ TXMLDataBindingUnresolvedItem }
constructor TXMLDataBindingUnresolvedItem.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String; AInterfaceType: TXMLDataBindingInterfaceType; AIsAttribute: Boolean);
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
inherited Create(AOwner, ASchemaItem, AName);
FInterfaceType := AInterfaceType;
FIsAttribute := AIsAttribute;
2008-03-09 20:36:27 +00:00
end;
function TXMLDataBindingUnresolvedItem.GetItemType: TXMLDataBindingItemType;
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
Result := itUnresolved;
2008-03-09 20:36:27 +00:00
end;
2008-04-18 14:36:17 +00:00
{ TXMLDataBindingComplexTypeAliasItem }
procedure TXMLDataBindingComplexTypeAliasItem.ReplaceItem(const AOldItem, ANewItem: TXMLDataBindingItem);
2008-03-09 20:36:27 +00:00
begin
2008-04-14 19:28:57 +00:00
inherited;
if FItem = AOldItem then
FItem := ANewItem;
2008-03-09 20:36:27 +00:00
end;
function TXMLDataBindingComplexTypeAliasItem.GetItemType: TXMLDataBindingItemType;
2008-04-18 14:36:17 +00:00
begin
Result := itComplexTypeAlias;
end;
{ TXMLDataBindingSimpleTypeAliasItem }
function TXMLDataBindingSimpleTypeAliasItem.GetItemType: TXMLDataBindingItemType;
begin
2008-04-18 14:36:17 +00:00
Result := itSimpleTypeAlias;
end;
2008-03-09 20:36:27 +00:00
end.