optosoapdomconv.pas

Delphi的Soap一些使用功能控件

  BuildHREFList(Converter, Node);
end;
{$ENDIF}

procedure TOPToSoapDomConvert.MsgToInvContext(const Request: TStream;
  const IntfMD: TIntfMetaData; var MethNum: Integer; Context: TInvContext;
  Headers: THeaderList);
var
  XmlDoc: IXMLDocument;
  I, J, K, L, ParamCount: Integer;
  MethodName, InternalMethodName, ExtParamName: InvString;
  EnvNode, MethNode, ParamNode, Node, HdrNode: IXMLNode;
  ProcessedBody: Boolean;
  MD: TIntfMethEntry;
  Translate: Boolean;
  ParamSerialOpts: TSerializationOptions;
begin
  XmlDoc := NewXMLDocument;
  Request.Position := 0;
  XmlDoc.LoadFromStream(Request);
{$IFDEF FASTER_CONVERTER}
  CreateHREFList(Self, XmlDoc.Node);
{$ENDIF}
  EnvNode := XmlDoc.DocumentElement;
  if EnvNode = nil then
    raise ESOAPDomConvertError.Create(SInvalidSOAPRequest);
  if (ExtractLocalName(EnvNode.NodeName) <> SSoapEnvelope) or (EnvNode.NamespaceURI <> SSoapNameSpace) then
    raise ESOAPDomConvertError.Create(SInvalidSOAPRequest);

  ProcessedBody := False;
  try
    if EnvNode.hasChildNodes then
    begin
      for I := 0 to EnvNode.childNodes.Count -1 do
      begin
        Node := EnvNode.childNodes[I];
        if Node.NodeType <> ntElement then
          continue;
        if ExtractLocalName(Node.NodeName) = SSoapHeader then
        begin
          if Node.hasChildNodes then
          begin
            for L := 0 to Node.childNodes.Count-1 do
            begin
              HdrNode := Node.childNodes[L];
              if HdrNode.NodeType <> ntElement then
                continue;
              ReadHeader(EnvNode, HdrNode, Headers);
            end;
          end;
        end
        else if ExtractLocalName(Node.NodeName) = SSoapBody then
        begin
          if ProcessedBody then
            raise ESOAPDomConvertError.Create(SMultiBodyNotSupported);
          CheckEncodingStyle(EnvNode);
          ProcessedBody := True;
          if Node.ChildNodes.Count > 0 then
          begin
            { Rather than assume that the first childNode is the method's
              node, it would be safer to use the 'root' attribute. However,
              SOAPBuilder can't seem to agree on 'root' currently. So for
              now, we'll stay with this approach }
            MethNode := ntElementChild(Node, 0);
            CheckEncodingStyle(MethNode);
            MethodName := ExtractLocalName(MethNode.NodeName);
            InternalMethodName := InvRegistry.GetMethInternalName(IntfMD.Info, MethodName);
            MethNum := GetMethNum(IntfMD, InternalMethodName, NtElementChildCount(MethNode));
            { Here know if there's a method for the request sent }
            if MethNum = -1 then
                raise ESOAPDomConvertError.CreateFmt(SNoSuchMethod, [MethodName, IntfMD.Name]);

            MD := IntfMD.MDA[MethNum];
            Context.SetMethodInfo(MD);
            Context.AllocServerData(MD);

            { Get native parameters }
            ParamCount := 0;
            for K := 0 to Length(MD.Params)-1 do
              if MD.Params[K].Name <> '' then
                Inc(ParamCount);

            for K := 0 to Length(MD.Params)-1 do
            begin
              { Skip non-parameters }
              if MD.Params[K].Name = '' then
                continue;
              { Was parameter renamed ? }
              ExtParamName := InvRegistry.GetParamExternalName(IntfMD.Info, InternalMethodName, MD.Params[K].Name);
              ParamSerialOpts := SerializationOptions(MD.Params[K].Info);
              for J := 0 to MethNode.childNodes.Count -1 do
              begin
                ParamNode := MethNode.childNodes[J];
                if ParamNode.NodeType <> ntElement then
                  continue;
                { Warning: In case sensitive contexts, it's possible to have parameters
                           that differ only in case - C++ }
                if SameText(ExtParamName, ExtractLocalName(ParamNode.NodeName)) then
                begin
                  CheckEncodingStyle(ParamNode);
                  Translate := (pfVar in MD.Params[K].Flags)
                    or (pfConst in  MD.Params[K].Flags)
                    or ([] =  MD.Params[K].Flags)
                    or ((pfReference in MD.Params[K].Flags) and (MD.Params[K].Info.Kind = tkVariant))
                    or ((pfReference in MD.Params[K].Flags) and (MD.Params[K].Info.Kind = tkString));
                  ConvertSoapToNativeData(Context.GetParamPointer(K), MD.Params[K].Info, Context, MethNode,
                    ParamNode, Translate, False,  1);
                  break;
                end
                  { Here we have an unhandled parameter node }
                  { Check if the name mismatches were due to wrapper classes }
                else if (xoHolderClass in ParamSerialOpts) and (ParamCount = 1) then
                begin
                  Translate := (pfVar in MD.Params[K].Flags)
                    or (pfConst in  MD.Params[K].Flags)
                    or ([] =  MD.Params[K].Flags)
                    or ((pfReference in MD.Params[K].Flags) and (MD.Params[K].Info.Kind = tkVariant))
                    or ((pfReference in MD.Params[K].Flags) and (MD.Params[K].Info.Kind = tkString));
                  ConvertSoapToNativeData(Context.GetParamPointer(K), MD.Params[K].Info, Context, MethNode,
                                          Node, Translate, False,  1);
                  break;
                end else
                begin
                  { Could not deserialize node... }
                  UnhandledNode(MethodName, ParamNode.XML);
                end;
              end;
            end;
          end;
        end;
      end;
    end else
      raise ESOAPDomConvertError.Create(SInvalidSOAPRequest);
  finally
    ResetMultiRef;
  end;
end;

procedure TOPToSoapDomConvert.DOMToStream(const XMLDoc: IXMLDocument; Stream: TStream);
var
  XMLWString: WideString;
  StrStr: TStringStream;
begin

  { NOTE: Typically you don't want us to UTF8 Encode if you've requested
          the DOM to encode; however, some implementations seem to
          indiscriminately UTF8Decode - so you can force UTF8 encoding, which
          will make us make the DOM ignore any encoding set
     *********************************************************************
       Remember to keep the Transport in sync. with any DOM encodings -
       namely the 'UseUTF8InHeader' property of the transport components     }

  if (FEncoding = '') or (soUTF8EncodeXML in Options) then
  begin
    XMLDoc.SaveToXML(XMLWString);
{$IFDEF FASTER_CONVERTER}
    StrStr := TStringStream.Create(UTF8Encode((XMLWString)));
{$ELSE}
    StrStr := TStringStream.Create(UTF8Encode(FormatXMLData(XMLWString)));
{$ENDIF}
    try
      Stream.CopyFrom(StrStr, 0);
    finally
      StrStr.Free;
    end;
  end else
    XMLDoc.SaveToStream(Stream);
end;

procedure TOPToSoapDomConvert.MakeResponse(const IntfMD: TIntfMetaData; const MethNum: Integer;
                                           Context: TInvContext; Response: TStream;
                                           Headers: THeaderList);
var
  I: Integer;
  XmlDoc: IXMLDocument;
  EnvNode, HeaderNode, BodyNode, MethNode, RootNode: IXMLNode;
  MD: TIntfMethEntry;
  SoapNS: InvString;
  ArgName: InvString;
  P: Pointer;
  Header: TObject;
begin
  MD := IntfMD.MDA[MethNum];
  XMLDoc := NewXMLDocument;
  XMLDoc.Encoding := FEncoding;
  EnvNode := Envelope.MakeEnvelope(XMLDoc, Options);
  XmlDoc.DocumentElement := EnvNode;

  { Result the MultiRef IDs as we're about to create a new Response }
  FIDS := 1;
  FAttachments.Clear;

  if (Headers <> nil) and (Headers.Count > 0) then
  begin
    HeaderNode := Envelope.MakeHeader(EnvNode);
    if not (soDocument in Options) then
      HeaderNode.SetAttributeNS(SSoapEncodingAttr, SSoapNameSpace, SSoap11EncodingS5);
    for I := 0 to Headers.Count-1 do
    begin
      Header := Headers[I];
      WriteHeader(Header, HeaderNode, HeaderNode);
    end;
  end;

  BodyNode := Envelope.MakeBody(EnvNode);
  if not (soDocument in Options) then
    BodyNode.SetAttributeNS(SSoapEncodingAttr, SSoapNameSpace, SSoap11EncodingS5);

  if not (soLiteralParams in Options) then
  begin
    SoapNS := GetSoapNS(IntfMD);
    if not (soDocument in Options) then
      MethNode := BodyNode.AddChild(MD.Name + SSoapResponseSuff, SoapNS, True)
    else
      MethNode := BodyNode.AddChild(MD.Name + SSoapResponseSuff, SoapNS)
  end else
  begin
    { If Literal params were not unwound, we don't need a method node }
    MethNode := BodyNode;
  end;

  { Compute Root Node }
  { NOTE: It's incorrect to root ref nodes to the method node - however, this was
          the way D6 originally shipped; therefore we offer it as an option in
          case you still have a D6 [unpatched] Service or Client that you need
          to support }
  if (soRootRefNodesToBody in Options) then
    RootNode := BodyNode
  else
    RootNode := MethNode;

  try
    if MD.ResultInfo <> nil  then
    begin
      ArgName := GetPartName(IntfMD, '');
      ConvertNativeDataToSoap(RootNode, MethNode, ArgName, MD.ResultInfo, Context.GetResultPointer, 1);
    end;
    for I := 0 to MD.ParamCount - 1  do
    begin
      if (pfVar in MD.Params[I].Flags) or (pfOut in MD.Params[I].Flags)
      then
      begin
        P := Context.GetParamPointer(I);
        ConvertNativeDataToSoap(RootNode, MethNode, MD.Params[I].Name, MD.Params[I].Info, P, 1);
      end;
    end;
  finally
    FinalizeMultiRefNodes;
    ResetMultiRef;
  end;

  { Let DOM write to stream - DOM handles Encoding }
  DOMToStream(XMLDoc, Response);
end;

function TOPToSoapDomConvert.GetSoapNS(MD: TIntfMetaData): InvString;
var
  ExtName: WideString;
begin
  if Assigned(WSDLView) then
  begin
    ExtName :=  InvRegistry.GetMethExternalName(MD.Info, WSDLVIew.Operation);
    Result := WSDLView.WSDL.GetSoapBodyAttribute(GetBinding, ExtName, WSDLBind.SInput, WSDLBind.SNameSpace, 0);
    { NOTE: Document Style WSDL don't have a namespace on the input/ouput nodes }
    if (Result = '') then
      Result := InvRegistry.GetNamespaceByGUID(MD.IID);
  end else
    Result := InvRegistry.GetNamespaceByGUID(MD.IID);
end;

procedure TOPToSoapDomConvert.MakeFault(const Ex: Exception; EStream: TStream);
var
  XmlDoc: IXMLDocument;
  EnvNode, BodyNode, FaultNode, FA, FC, FS, FD, CustNode: IXMLNode;
  I, Count: Integer;
  PropList: PPropList;
  URI, TypeName: WideString;
  IsScalar: Boolean;
  RemException: ERemotableException;
begin
  XMLDoc := NewXMLDocument;
  XMLDoc.Encoding := FEncoding;
  EnvNode := Envelope.MakeEnvelope(XMLDoc, Options);
  BodyNode := Envelope.MakeBody(EnvNode);
  FaultNode := Envelope.MakeFault(BodyNode);
  FA := FaultNode.AddChild(SSoapFaultActor, '');
  FC := FaultNode.AddChild(SSoapFaultCode, '');
  { NOTE: We map the FaultString to Exception's Message }
  FS := FaultNode.AddChild(SSoapFaultString, '');
  FS.Text := Ex.Message;
  if Ex.InheritsFrom(ERemotableException) then
  begin
    RemException := ERemotableException(Ex);
    FA.Text := RemException.FaultActor;
    FC.Text := MakeNodeName(SSoapNameSpacePre, RemException.FaultCode);

    RemClassRegistry.ClassToURI(Ex.ClassType, URI, TypeName, IsScalar);

    { The follow logic is *NOT* as per the SOAP spec. The spec wants
      specific information under the details node - not *AT* the details
      node !!!! But we offer it as an option given that Delphi6, which
      had limited (Delphi<->Delphi) Fault support followed that approach }
    if (soCustomFaultAtDetailsNode in Options) then
    begin
      FD := FaultNode.AddChild(SSoapFaultDetails, URI, True);
      CustNode := FD;
    end
    else
    begin
      FD := FaultNode.AddChild(SSoapFaultDetails, '');
      CustNode := FD.AddChild(TypeName, URI, True);
    end;

    { Set the type }
    CustNode.SetAttributeNS(SSoapType, XMLSchemaInstNameSpace, MakeNodeName(CustNode.Prefix, TypeName));

    Count := GetTypeData(Ex.ClassInfo)^.PropCount;
    if Count > 0 then
    begin
      GetMem(PropList, Count * SizeOf(Pointer));
      try
        GetPropInfos(Ex.ClassInfo, PropList);
        for I := 0 to Count - 1 do
        begin
          if not RemTypeRegistry.TypeInfoToXSD( (PropList[I].PropType)^, URI, TypeName) then
            raise ESOAPDomConvertError.CreateFmt(SRemTypeNotRegistered, [(PropList[I].PropType)^.Name]);
          CreateScalarNodeXS(CustNode, CustNode, PropList[I].Name, URI, TypeName, GetObjectPropAsText(Ex, PropList[I]));
        end;
      finally
        FreeMem(PropList, Count * SizeOf(Pointer));
      end;
    end;
  end else
  begin
    { Fault Code }
    FC.Text := MakeNodeName(SSoapNameSpacePre, 'Server');   { Do not localize }
  end;
  DOMToStream(XmlDoc, EStream);
end;

function TOPToSoapDomConvert.InvContextToMsg(const IntfMD: TIntfMetaData; MethNum: Integer;
                                             Con: TInvContext; Headers: THeaderList): TStream;
var
  XMLDoc: IXMLDocument;
  EnvNode, HeaderNode, BodyNode, MethNode: IXMLNode;
  I: Integer;
  SoapMethNS: InvString;
  MethMD: TIntfMethEntry;
  P: Pointer;
  Indir: Integer;
  URI, ExtMethName, ExtParamName: InvString;
  Header: TObject;
begin
  MethMD := IntfMD.MDA[MethNum];

{$IFDEF FIX_ELEM_NODE_NS}
  ElemNodeNamespace := '';
{$ENDIF}