Watch, Follow, &
Connect with Us

For forums, blogs and more please visit our
Developer Tools Community.


ID: 20269, OPToSOAPDomConv changes to allow enumerated types to change valu

by Mehul Harry Email: Anonymous


Soap Enumerated Types Change Keyword Value Reserved TSOAPDomConv RemClassRegistry ObjInstanceToSOAP
Download Details
FTP  download also available 0 bytes
CDN Login Required to Download. (You will be redirected to the login page if you click on the Download Link)
To download this, you must have registered:
A free membership

For Delphi, Version 7.0  to 7.0 10 downloads
Copyright: No significant restrictions


Size: 0 bytes
Updated on Wed, 02 Jul 2003 17:47:49 GMT
Originally uploaded on Wed, 02 Jul 2003 16:58:31 GMT
Description
My problem was I have an enum type called Region that contains the various supported states for my proj:

Region = (AZ, CO, DE, FL, regIN, KY, MD, regOR, RI, TX, WV);

Indiana and Orgeon cause a syntax problem so I prefixed them but I needed to remove that prefix before the soap packet was sent. I know I could have intercepted the HTTPRIO.BeforeExecute event but there were others and I didn't want to do this for future projects also.

I wanted to be able to register them allow the converter do the job, i.e.:

In ...SoapClasses.pas

RemClassRegistry.RegisterExternalPropName(TypeInfo(Region), 'regOR', 'OR');
RemClassRegistry.RegisterExternalPropName(TypeInfo(Region), 'regIN', 'IN');

So, the following changes were implemented that would allow changing enumerated values (many thanks to Atanas S. for the changes).

I am including the whole method but the changed are commented as:

//All credit must go to Atanas Stoyanov for the changes to the unit.
//ATS - new code added
//end new code added
//OPToSOAPDomConv.pas
function TSOAPDomConv.ObjInstanceToSOAP(Instance: TObject; RootNode, ParentNode: IXMLNode;
const NodeName, NodeNamespace: InvString; ObjConvOpts: TObjectConvertOptions;
out RefID: InvString): IXMLNode;
var
ID, Pre: InvString;
I, Count: Integer;
PropList: PPropList;
Kind: TTypeKind;
V: Variant;
Obj: TObject;
ElemURI, TypeName, TypeNamespace, NodeVal: InvString;
PrefixNode, InstNode, ElemNode, AttrNode: IXMLNode;
P: Pointer;
ExtPropName: InvString;
MultiRef, UsePrefix, SerializeProps, CanHaveType, HolderClass, LitParam : Boolean;
SerialOpts: TSerializationOptions;
ClsType: TClass;
begin
{ Get a new ID for this node - in case we're MultiRefing... }
RefID := GetNewID;

{ Retrieve the Serializatin options of this class }
SerialOpts := SerializationOptions(Instance);

{ Type attribute }
HolderClass := (xoHolderClass in SerialOpts);
LitParam := (xoLiteralParam in SerialOpts);

{ Object Custom Serialization flags }
UsePrefix := not (ocoDontPrefixNode in ObjConvOpts);
SerializeProps := not (ocoDontSerializeProps in ObjConvOpts);
CanHaveType := not (ocoDontPutTypeAttr in ObjConvOpts) and (not LitParam);

{ Get namespace prefix }
PrefixNode := RootNode;

{ Are we multiref'in the node }
MultiRef := MultiRefObject(Instance.ClassType);

{ No prefix in document style - or if flag set to false }
if not (soDocument in Options) and UsePrefix then
Pre := FindPrefixForURI(PrefixNode, ParentNode, NodeNamespace, True)
else
Pre := '';

{ Create the Node, if necessary }
if not HolderClass then
begin
if not MultiRef then
begin
if (soDocument in Options) then
begin
RemClassRegistry.ClassToURI(Instance.ClassType, TypeNamespace, TypeName);
if TypeNamespace = XMLSchemaNamespace then
InstNode := ParentNode.AddChild(NodeName)
else
InstNode := ParentNode.AddChild(NodeName, TypeNamespace);
end
else
begin
if UsePrefix or (Pre <> '') then
InstNode := ParentNode.AddChild(MakeNodeName(Pre, NodeName))
else
{ Create a node without any prefix }
InstNode := ParentNode.AddChild(NodeName, '');
end;
end
else
InstNode := CreateMultiRefNode(RootNode, MakeNodeName(Pre, NodeName), RefID);
end
else
{ Here this class was simply a holder - only its members are serialized!
the class itself is stealth }
InstNode := ParentNode;

{ Set Result Node }
Result := InstNode;

{ Can this type generate xsi:type attributes?? }
if CanHaveType then
begin
{ Retrieve Type Namespace }
RemClassRegistry.ClassToURI(Instance.ClassType, TypeNamespace, TypeName);
{ xsi:type=?? }
SetNodeType(PrefixNode, InstNode, TypeNamespace, TypeName);
end;

{ Store info that we multi refed' }
if MultiRef then
AddMultiRefNode(RefID, Instance);

{ Serialize Published Properties ?? }
if SerializeProps then
begin
{ Serialized published properties }
Count := GetTypeData(Instance.ClassInfo)^.PropCount;
if Count > 0 then
begin
GetMem(PropList, Count * SizeOf(Pointer));
try
GetPropInfos(Instance.ClassInfo, PropList);

{ Complex type as wrapper of a simple type }
if (xoSimpleTypeWrapper in SerialOpts) and (Count = 1) then
begin
NodeVal := GetObjectPropAsText(Instance, PropList[0]);
InstNode.Text := NodeVal;
end else
begin
for I := 0 to Count - 1 do
begin
ExtPropName := RemTypeRegistry.GetExternalPropName(Instance.ClassInfo, PropList[I].Name);
Kind := (PropList[I].PropType)^.Kind;
{ Class Property }
if Kind = tkClass then
begin
Obj := GetObjectProp(Instance, PropList[I]);
if Obj = nil then
begin
if not (soDontSendEmptyNodes in Options) then
CreateNULLNode(RootNode, InstNode, ExtPropName)
end
else
begin
ClsType := GetTypeData((PropList[I].PropType)^).ClassType;
RemClassRegistry.ClassToURI(ClsType, ElemURI, TypeName);

MultiRef := MultiRefObject(ClsType);

if not MultiRef then
begin
if IsObjectWriting(Obj) then
raise ESOAPDomConvertError.CreateFmt(SNoSerializeGraphs, [Obj.ClassName]);
AddObjectAsWriting(Instance);
{ NOTE: prefix for nested types ?? }
CreateObjectNode(Obj, RootNode, InstNode, ExtPropName, ElemURI, ObjConvOpts);
RemoveObjectAsWriting(Obj);
end else
begin
ElemNode := InstNode.AddChild(ExtPropName, '');
ID := FindMultiRefNodeByInstance(Obj);
{ NOTE: prefix for nested types ?? }
if ID = '' then
ID := CreateObjectNode(Obj, RootNode, InstNode, ExtPropName, ElemURI, ObjConvOpts);
ElemNode.Attributes[SXMLHREF] := SHREFPre + ID;
end;
end;
{ Array property }
end else if Kind = tkDynArray then
begin
P := Pointer(GetOrdPropEx(Instance, PropList[I]));
ConvertNativeArrayToSoap(RootNode, InstNode, ExtPropName,
(PropList[I].PropType)^, P, 0,
(xoInlineArrays in SerialOpts));
{ Variant property }
end else if Kind = tkVariant then
begin
V := GetVariantProp(Instance, PropList[I]);
ConvertVariantToSoap(RootNode, InstNode, ExtPropName, nil, nil, 0, V, True);
end else
{ Simple type property ?? }
begin
if not RemTypeRegistry.TypeInfoToXSD((PropList[I].PropType)^, ElemURI, TypeName) then
raise ESOAPDomConvertError.CreateFmt(SRemTypeNotRegistered, [(PropList[I].PropType)^.Name]);
{ Here we check the stored property flag - that's the flag to use an
attribute instead of a separate node - if the property is marked
stored False, we'll use an attribute instead }
if not IsStoredProp(Instance, PropList[I]) then
begin
{ Typically attributes go on the root/instance node. However, in some
cases the class serializes members and then the attribute goes on
the last member; this option allows attributes on specific members }
AttrNode := InstNode;
if (xoAttributeOnLastMember in SerialOpts) then
begin
if ntElementChildCount(InstNode) > 0 then
AttrNode := ntElementChild(InstNode, ntElementChildCount(InstNode)-1);
end;
//ATS - new code added
if Kind = tkEnumeration then
begin
NodeVal := GetObjectPropAsText(Instance, PropList[I]);
NodeVal := RemTypeRegistry.GetExternalPropName(PropList[I].PropType^, NodeVal);
end
else
//end new code added
NodeVal := GetObjectPropAsText(Instance, PropList[I]);
{ Check if user does not want to send empty nodes }
if (not (soDontSendEmptyNodes in Options)) or (NodeVal <> '') then
AttrNode.Attributes[ExtPropName] := NodeVal;
end
else
begin
//ATS - new code added
if Kind = tkEnumeration then
begin
NodeVal := GetObjectPropAsText(Instance, PropList[I]);
NodeVal := RemTypeRegistry.GetExternalPropName(PropList[I].PropType^, NodeVal);
end
else
//end new code added
NodeVal := GetObjectPropAsText(Instance, PropList[I]);
{ Check if user does not want to send empty nodes }
if (not (soDontSendEmptyNodes in Options)) or (NodeVal <> '') then
ElemNode := CreateScalarNodeXS(RootNode, InstNode, ExtPropName, ElemURI, TypeName, NodeVal);
end;
end;
end;
end;
finally
FreeMem(PropList, Count * SizeOf(Pointer));
end;
end;
end;
end;

   Latest Comments  View All Add New

Move mouse over comment to see the full text

Could not retrieve comments. Please try again later.

Server Response from: ETNACDC03