I use a XML schema file ( *.xdr) to generated a interface file ,
But when I use the code blew :
var
envelope :IEnvelopeType
begin
envelope := GetEnvelope(xml);
it raised an exception
EintfCastError: Interface not supported.
I wonder what's wrong with my code ?
can someone give me a hand ?
The following is the schema :
***************************************************************************
<?xml version="1.0" encoding="GB2312" ?>
<!-- This is an XDR,XML-Data Reduced Schema -->
<Schema name="Eachnet_Assistant" xmlns="urn:schemas-microsoft-com:xml-data"
xmlns:dt="urn:schemas-microsoft-com:datatypes">
<AttributeType name="ID" dt:type="Int" required="yes"/>
<ElementType name="Title" content="textOnly" dt:type="char"/>
<ElementType name="Description" content="textOnly" dt:type="char"/>
<ElementType name="Goods" content="mixed" order="many" model="closed">
<attribute type="ID" required="No"/>
<element type="Title"/>
<element type="Description"/>
</ElementType>
<ElementType name="Body" content="eltOnly" >
<element type="Goods" maxOccurs="*"/>
</ElementType>
<!--
*********************************************************************-->
<ElementType name="Envelope" content="eltOnly" model="closed">
<element type="Body" minOccurs="0" maxOccurs="1"/>
</ElementType>
</Schema>
--
****************************
****************************
interface
uses xmldom, XMLDoc, XMLIntf;
type
{ Forward Decls }
IGoodsType = interface;
IBodyType = interface;
IEnvelopeType = interface;
ITitleTypeList = interface;
IDescriptionTypeList = interface;
{ IGoodsType }
IGoodsType = interface(IXMLNode)
['{5C7C43F1-0B4E-4BFB-A1DC-1E2F21986AE7}']
{ Property Accessors }
function Get_ID: WideString;
function Get_Title: ITitleTypeList;
function Get_Description: IDescriptionTypeList;
procedure Set_ID(Value: WideString);
{ Methods & Properties }
property ID: WideString read Get_ID write Set_ID;
property Title: ITitleTypeList read Get_Title;
property Description: IDescriptionTypeList read Get_Description;
end;
{ IBodyType }
IBodyType = interface(IXMLNodeCollection)
['{44AA01C0-EA50-42B1-8DCD-0DF5329C34D9}']
{ Property Accessors }
function Get_Goods(Index: Integer): IGoodsType;
{ Methods & Properties }
function Add: IGoodsType;
function Insert(const Index: Integer): IGoodsType;
property Goods[Index: Integer]: IGoodsType read Get_Goods; default;
end;
{ IEnvelopeType }
IEnvelopeType = interface(IXMLNode)
['{39D11D65-14F5-4055-85D8-058A3926CF35}']
{ Property Accessors }
function Get_Body: IBodyType;
{ Methods & Properties }
property Body: IBodyType read Get_Body;
end;
{ ITitleTypeList }
ITitleTypeList = interface(IXMLNodeCollection)
['{8F113A54-7E0F-4D31-BA12-BAA5AF664271}']
{ Methods & Properties }
function Add(const Value: ShortInt): IXMLNode;
function Insert(const Index: Integer; const Value: ShortInt): IXMLNode;
function Get_Item(Index: Integer): ShortInt;
property Items[Index: Integer]: ShortInt read Get_Item; default;
end;
{ IDescriptionTypeList }
IDescriptionTypeList = interface(IXMLNodeCollection)
['{8492F8BA-940E-4BB2-B8BF-7F274D47CCFA}']
{ Methods & Properties }
function Add(const Value: ShortInt): IXMLNode;
function Insert(const Index: Integer; const Value: ShortInt): IXMLNode;
function Get_Item(Index: Integer): ShortInt;
property Items[Index: Integer]: ShortInt read Get_Item; default;
end;
{ Forward Decls }
TGoodsType = class;
TBodyType = class;
TEnvelopeType = class;
TTitleTypeList = class;
TDescriptionTypeList = class;
{ TGoodsType }
TGoodsType = class(TXMLNode, IGoodsType)
private
FTitle: ITitleTypeList;
FDescription: IDescriptionTypeList;
protected
{ IGoodsType }
function Get_ID: WideString;
function Get_Title: ITitleTypeList;
function Get_Description: IDescriptionTypeList;
procedure Set_ID(Value: WideString);
public
procedure AfterConstruction; override;
end;
{ TBodyType }
TBodyType = class(TXMLNodeCollection, IBodyType)
protected
{ IBodyType }
function Get_Goods(Index: Integer): IGoodsType;
function Add: IGoodsType;
function Insert(const Index: Integer): IGoodsType;
public
procedure AfterConstruction; override;
end;
{ TEnvelopeType }
TEnvelopeType = class(TXMLNode, IEnvelopeType)
protected
{ IEnvelopeType }
function Get_Body: IBodyType;
public
procedure AfterConstruction; override;
end;
{ TTitleTypeList }
TTitleTypeList = class(TXMLNodeCollection, ITitleTypeList)
protected
{ ITitleTypeList }
function Add(const Value: ShortInt): IXMLNode;
function Insert(const Index: Integer; const Value: ShortInt): IXMLNode;
function Get_Item(Index: Integer): ShortInt;
end;
{ TDescriptionTypeList }
TDescriptionTypeList = class(TXMLNodeCollection, IDescriptionTypeList)
protected
{ IDescriptionTypeList }
function Add(const Value: ShortInt): IXMLNode;
function Insert(const Index: Integer; const Value: ShortInt): IXMLNode;
function Get_Item(Index: Integer): ShortInt;
end;
{ Global Functions }
function GetEnvelope(Doc: IXMLDocument): IEnvelopeType;
function LoadEnvelope(const FileName: WideString): IEnvelopeType;
function NewEnvelope: IEnvelopeType;
implementation
{ Global Functions }
function GetEnvelope(Doc: IXMLDocument): IEnvelopeType;
begin
Result := Doc.GetDocBinding('Envelope', TEnvelopeType) as IEnvelopeType;
end;
function LoadEnvelope(const FileName: WideString): IEnvelopeType;
begin
Result := LoadXMLDocument(FileName).GetDocBinding('Envelope',
TEnvelopeType) as IEnvelopeType;
end;
function NewEnvelope: IEnvelopeType;
begin
Result := NewXMLDocument.GetDocBinding('Envelope', TEnvelopeType) as
IEnvelopeType;
end;
{ TGoodsType }
procedure TGoodsType.AfterConstruction;
begin
FTitle := CreateCollection(TTitleTypeList, IXMLNode, 'Title') as
ITitleTypeList;
FDescription := CreateCollection(TDescriptionTypeList, IXMLNode,
'Description') as IDescriptionTypeList;
inherited;
end;
function TGoodsType.Get_ID: WideString;
begin
Result := AttributeNodes['ID'].Text;
end;
procedure TGoodsType.Set_ID(Value: WideString);
begin
SetAttribute('ID', Value);
end;
function TGoodsType.Get_Title: ITitleTypeList;
begin
Result := FTitle;
end;
function TGoodsType.Get_Description: IDescriptionTypeList;
begin
Result := FDescription;
end;
{ TBodyType }
procedure TBodyType.AfterConstruction;
begin
RegisterChildNode('Goods', TGoodsType);
ItemTag := 'Goods';
ItemInterface := IGoodsType;
inherited;
end;
function TBodyType.Get_Goods(Index: Integer): IGoodsType;
begin
Result := List[Index] as IGoodsType;
end;
function TBodyType.Add: IGoodsType;
begin
Result := AddItem(-1) as IGoodsType;
end;
function TBodyType.Insert(const Index: Integer): IGoodsType;
begin
Result := AddItem(Index) as IGoodsType;
end;
{ TEnvelopeType }
procedure TEnvelopeType.AfterConstruction;
begin
RegisterChildNode('Body', TBodyType);
inherited;
end;
function TEnvelopeType.Get_Body: IBodyType;
begin
Result := ChildNodes['Body'] as IBodyType;
end;
{ TTitleTypeList }
function TTitleTypeList.Add(const Value: ShortInt): IXMLNode;
begin
Result := AddItem(-1);
Result.NodeValue := Value;
end;
function TTitleTypeList.Insert(const Index: Integer; const Value: ShortInt):
IXMLNode;
begin
Result := AddItem(Index);
Result.NodeValue := Value;
end;
function TTitleTypeList.Get_Item(Index: Integer): ShortInt;
begin
Result := List[Index].NodeValue;
end;
{ TDescriptionTypeList }
function TDescriptionTypeList.Add(const Value: ShortInt): IXMLNode;
begin
Result := AddItem(-1);
Result.NodeValue := Value;
end;
function TDescriptionTypeList.Insert(const Index: Integer; const Value:
ShortInt): IXMLNode;
begin
Result := AddItem(Index);
Result.NodeValue := Value;
end;
function TDescriptionTypeList.Get_Item(Index: Integer): ShortInt;
begin
Result := List[Index].NodeValue;
end;
end.
function GetEnvelope(Doc: IXMLDocument): IEnvelopeType;
implementation
{ Global Functions }
function GetEnvelope(Doc: IXMLDocument): IEnvelopeType;
begin
Result := Doc.GetDocBinding('Envelope', TEnvelopeType) as IEnvelopeType;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
the above line raised the exception
end;
##the function return IXMLNode
*****blew is the define of IEnvelopeType******************
Make sure that when you call this function, you pass an IXMLDocument which is
been loaded with a document that contains a document element called "Envelope".
If it doesn't, then you'll get the interface not supported error.
If you want to create a new document, use the NewDocBinding method instead.
Mark