webservexp.pas

delphi7 webservice soap 补丁

    I: Integer;
  begin
    Result := Item.DefaultRequired;
    if Item.MethodNames <> '' then
    begin
      Meths := TStringList.Create;
      try
        Meths.CommaText := Item.MethodNames;
        for I := 0 to Meths.Count -1 do
          if SameText(Meths[I], MethName) then
          begin
            Result := Item.HeaderRequired[I];
            break;
          end;
      finally
        Meths.Free;
      end;
    end;
  end;

  function SetupMultiPartRelatedNode(const MPRelatedNode: IXMLNode;
                                     const MethodExtName: WideString;
                                     Input: Boolean;
                                     const HdrMsgName: WideString): IXMLNode;
  var
    I: Integer;
    PartName, Namespace: WideString;
    AClass: TClass;
  begin
    PartNode := MPRelatedNode.AddChild(SPart, SWSDLMIMENamespace);
    SoapBodyNode := PartNode.AddChild(SBody, Soapns);
    SetupSoapBodyNode(SoapBodyNode);

    if Input then
      HeaderItems := InvRegistry.GetRequestHeaderInfoForInterface(IntfMD.Info)
    else
      HeaderItems := InvRegistry.GetResponseHeaderInfoForInterface(IntfMD.Info);

    for I := 0 to Length(HeaderItems) -1 do
    begin
      if HeaderUsedWithMethod(HeaderItems[I], MethodExtName, hmtRequest) then
      begin
        AClass := HeaderItems[I].ClassType;
        PartName := InvRegistry.GetHeaderName(IntfMD.Info, AClass);
        Namespace:= InvRegistry.GetHeaderNamespace(IntfMD.Info, AClass);
        SoapHeaderNode := NewNode.AddChild(SHeader, Soapns);
        SetupSoapHeaderNode(SoapHeaderNode, TnsPre + ':' + HdrMsgName,
                 PartName, Namespace, HeaderRequired(MethodExtName, HeaderItems[I]));
      end;
    end;
  end;

  procedure SetupMultiPartNode(const MPRelatedNode: IXMLNode; const ParamName: String);
  begin
    PartNode := MPRelatedNode.AddChild(SPart, SWSDLMIMENamespace);
    ContentNode := PartNode.AddChild('content');
    { TODO User:BB Must retrieve external name of parameter }
    ContentNode.SetAttributeNS(SPart, '', ParamName);
    ContentNode.SetAttributeNS(SType, '', 'application/binary');
  end;

var
  I, Methods, NoOfMethods, Params: Integer;
  ParamArray: TIntfParamEntryArray;
  Bindings: IBindings;
  Binding: IBinding;
  BindOperations: IBindingOperations;
  NewBindOperation: IBindingOperation;
  MPartRelated : IXMLNode;
  PartName, PortExtName, MethodExtName, HeaderNamespace: WideString;
  MethodBindingType: TWebServiceBindingType;
  MethNames: TWideStrings;
  OverloadDigit: string;
  ExceptItems: TExceptionItemArray;
  AClass: TClass;
begin
  SetLength(ParamArray, 0);
  { Method Array }
  NoOfMethods   := Length(IntfMD.MDA);

  { Porttype Name + Namespace }
  PortExtName := InvRegistry.GetInterfaceExternalName(IntfMD.Info,'',IntfMD.Name);
  TnsPre := GetPrefixForURI(WSDLDoc.Definition, TargetNameSpace);

  { Add WSDL Binding and its Operations }
  Bindings := WSDLDoc.Definition.Bindings;
  Binding := Bindings.Add(PortExtName+SBinding,TnsPre + ':' + PortExtName);

  { Add Binding specific elements }
  if FBindingType = btSoap then
  begin
    { Add soap:binding }
    NewNode := Binding.AddChild(SBinding, Soapns);
    NewNode.Attributes[SStyle] := 'rpc';
    NewNode.Attributes[STransport] := SSoapHTTPTransport;
  end;
  OverloadDigit := '';

  ExceptItems := InvRegistry.GetExceptionInfoForInterface(IntfMD.Info);

  MethNames := TWideStrings.Create;
  try
    { Generate input and output nodes for operations of this binding }
    for Methods := 0 to NoOfMethods -1 do
    begin
      { Add operation node }
      MethodExtName := InvRegistry.GetMethExternalName(IntfMD.Info, IntfMD.MDA[Methods].Name);
      BindOperations := Binding.BindingOperations;
      NewBindOperation := BindOperations.Add(MethodExtName);

      if FBindingType = btSoap then
      begin
        { Add soap:operation }
        NewNode := NewBindOperation.AddChild(SOperation, Soapns);
        NewNode.Attributes[SSoapAction] := InvRegistry.GetActionURIOfInfo(IntfMD.Info, MethodExtName, Methods);
        NewNode.Attributes[SStyle] := 'rpc';  
      end;

      { Get parameters }
      ParamArray := IntfMD.MDA[Methods].Params;

      { Find the Input Binding Type }
      MethodBindingType := GetBindingType(IntfMD.MDA[Methods], True);

      { Add input/output }
      NewNode := NewBindOperation.AddChild(SInput);

      {
        Having the message attribute is only necessary to disambiguate overloaded methods:

        "An operation element within a binding specifies binding information for the operation with
         the same name within the binding's portType. Since operation names are not required to be
         unique (for example, in the case of overloading of method names), the name attribute in the
         operation binding element might not be enough to uniquely identify an operation. In that
         case, the correct operation should be identified by providing the name attributes of the
         corresponding wsdl:input and wsdl:output elements.
      }
{$IFDEF MESSAGE_ON_BINDING_IO_NODES}
      NewNode.Attributes[SMessage] := TnsPre + ':' + GetMessageName(MethodExtName, Methods, mtInput);
{$ENDIF}
      if MethodBindingType = btSoap then
      begin
        SoapBodyNode := NewNode.AddChild(SBody, Soapns);
        SetupSoapBodyNode(SoapBodyNode);
        HeaderItems := InvRegistry.GetRequestHeaderInfoForInterface(IntfMD.Info);
        for I := 0 to Length(HeaderItems) -1 do
        begin
          if HeaderUsedWithMethod(HeaderItems[I], MethodExtName, hmtRequest) then
          begin
            AClass := HeaderItems[I].ClassType;
            PartName := InvRegistry.GetHeaderName(IntfMD.Info, AClass);
            HeaderNamespace := InvRegistry.GetHeaderNamespace(IntfMD.Info, AClass);

            SoapHeaderNode := NewNode.AddChild(SHeader, Soapns);
            SetupSoapHeaderNode(SoapHeaderNode, TnsPre + ':' +
                                GetMessageName(MethodExtName, Methods, mtHeaderInput),
                                PartName, HeaderNamespace,
                                HeaderRequired(MethodExtName, HeaderItems[I]));
          end;
        end;
      end else if MethodBindingType = btMIME then
      begin
        { We make the <input> node's name match that of the input message of this operation -
          NOTE: This is purely conventional - i.e not according to the spec. }
        NewNode.SetAttributeNS(Sname, '', GetMessageName(MethodExtName, Methods, mtInput));

        { TODO Localize these strings  - move to SOAPConst }
        MPartRelated := NewNode.AddChild(SMultiPartRelatedNoSlash, SWSDLMIMENamespace, True);
        SetupMultiPartRelatedNode(MPartRelated, MethodExtName, True,
                                  GetMessageName(MethodExtName, Methods, mtHeaderInput));

        { Here add <mime:part ><mime:content>...</mime:content></mime:part> nodes for
          each MultiPart parameter }
        { NOTE: Skip this/Self }
        for Params := 0 to Length(ParamArray)-2 do
        begin
          if IsInputParam(ParamArray[Params]) and
             (GetBindingType(ParamArray[Params]) = btMIME) then
          begin
            { TODO User:BB Must retrieve external name of parameter }
            SetupMultiPartNode(MPartRelated, ParamArray[Params].Name);
          end;
        end;
      end;

      { Output Node }
      { According to the spec, we don't really need an <output..> node; however,
        the current version of Axis/Apache is not very happy when that node
        is missing:

        java.lang.NullPointerException
              at org.apache.axis.wsdl.WsdlAttributes.scanBindings(WsdlAttributes.java:271)
              at org.apache.axis.wsdl.WsdlAttributes.init(WsdlAttributes.java:114)
              at org.apache.axis.wsdl.WsdlAttributes.<init>(WsdlAttributes.java:109)
              at org.apache.axis.wsdl.Emitter.emit(Emitter.java:169)
              at org.apache.axis.wsdl.Emitter.emit(Emitter.java:134)
              at org.apache.axis.wsdl.Wsdl2java.main(Wsdl2java.java:199)
        Error in parsing: null

        I've relayed the issue; but in the meantime, we'll output a node anyway
      }
      { if IntfMD.MDA[Methods].ResultInfo <> nil  then }
      NewNode := NewBindOperation.AddChild(SOutput);

      { See note on Input node about the message attribute }
{$IFDEF MESSAGE_ON_BINDING_IO_NODES}
      NewNode.Attributes[SMessage] := TnsPre + ':' + GetMessageName(MethodExtName, Methods, mtOutput);
{$ENDIF}
      
      { Find the Output Binding Type }
      MethodBindingType := GetBindingType(IntfMD.MDA[Methods], False);

      if MethodBindingType = btSoap then
      begin
        SoapBodyNode := NewNode.AddChild(SBody, Soapns);
        SetupSoapBodyNode(SoapBodyNode);
        HeaderItems := InvRegistry.GetResponseHeaderInfoForInterface(IntfMD.Info);
        for I := 0 to Length(HeaderItems) -1 do
        begin
          if HeaderUsedWithMethod(HeaderItems[I], MethodExtName, hmtResponse) then
          begin
            AClass := HeaderItems[I].ClassType;
            PartName := InvRegistry.GetHeaderName(IntfMD.Info, AClass);
            HeaderNamespace := InvRegistry.GetHeaderNamespace(IntfMD.Info, AClass);

            SoapHeaderNode := NewNode.AddChild(SHeader, Soapns);
            SetupSoapHeaderNode(SoapHeaderNode, TnsPre + ':' +
                                GetMessageName(MethodExtName, Methods, mtHeaderOutput),
                                PartName, HeaderNamespace,
                                HeaderRequired(MethodExtName, HeaderItems[I]));
          end;
        end;
      end else if MethodBindingType = btMIME then
      begin
        { We make the <input> node's name match that of the input message of this operation -
          NOTE: This is purely conventional - i.e not according to the spec. }
        NewNode.SetAttributeNS(Sname, '', GetMessageName(MethodExtName, Methods, mtOutput));

        { TODO Localize these strings  - move to SOAPConst }
        MPartRelated := NewNode.AddChild(SMultiPartRelatedNoSlash, SWSDLMIMENamespace, True);
        SetupMultiPartRelatedNode(MPartRelated, MethodExtName, False,
                                  GetMessageName(MethodExtName, Methods, mtHeaderOutput));

        { Here add <mime:part ><mime:content >...</mime:content></mime:part> nodes for
          each MultiPart parameter }
        { NOTE: Skip this/Self }
        for Params := 0 to Length(ParamArray)-2 do
        begin
          if IsOutputParam(ParamArray[Params]) and
             (GetBindingType(ParamArray[Params]) = btMIME) then
          begin
            { TODO User:BB Must retrieve external name of parameter }
            SetupMultiPartNode(MPartRelated, ParamArray[Params].Name);
          end;
        end;

        { For output we also check the return type, if any }
        if GetBindingType(IntfMD.MDA[Methods].ResultInfo) = btMIME then
        begin
          SetupMultiPartNode(MPartRelated, SReturn);
        end;
      end;

      { Fault Binding }
      for I := 0 to Length(ExceptItems) -1 do
      begin
        if ExceptionUsedWithMethod(ExceptItems[I], MethodExtName) then
        begin
          NewNode := NewBindOperation.AddChild(SFault);
          NewNode := NewNode.AddChild(SFault, Soapns);
          SetUpSoapBodyNode(NewNode);
          break;
        end;
      end
    end;
  finally
    MethNames.Free;
  end;

end;

procedure TWebServExp.AddServices(const IntfMD: TIntfMetaData; WSDLDoc: IWSDLDocument; PortNames: array of WideString; Locations: array of WideString);
var
  Services: IServices;
  NewService: IService;
  NewPort: IPort;
  NewNode: IXMLNode;
  I: Integer;
  PortExtName: WideString;
  TnsPre: WideString;
begin

  Services := WSDLDoc.Definition.Services;
  PortExtName := InvRegistry.GetInterfaceExternalName(IntfMD.Info,'',IntfMD.Name);
  NewService := Services.Add(PortExtName + SService);
  for I := 0 to Length(Locations) - 1 do
  begin
    TnsPre := GetPrefixForURI(WSDLDoc.Definition, TargetNameSpace);
    NewPort := NewService.Ports.Add(PortNames[I], TnsPre + ':' + PortExtName+SBinding);
    NewNode := NewPort.AddChild(SAddress, Soapns);
    NewNode.Attributes[SLocation] := Locations[I];
  end;
end;

procedure TWebServExp.AddTypes(const IntfMD: TIntfMetaData; WSDLDoc: IWSDLDocument);
var
{  NewNode: IXMLNode; }
  SchemaDef: IXMLSchemaDef;
  Index, Count: Integer;
  UniqueURI: TWideStrings;
begin
  { Collect all schema types to be generated }
  GetAllSchemaTypes(IntfMD);
  { Allow user chance to add more types }
  if Assigned(FOnBeforePublishingTypes) then
    FOnBeforePublishingTypes(Self);

  if  Length(SchemaArray) > 0 then
  begin
    UniqueURI := TWideStrings.Create;
    try
      { Get Unique URI's and namespace prefix }
      for Index := 0 to Length(SchemaArray) -1 do
      begin
        if (UniqueURI.IndexOf(SchemaArray[Index].NameSpace)= -1) then
          UniqueURI.Add(SchemaArray[Index].NameSpace);
        SchemaArray[Index].NSPrefix := GetPrefixForURI(Definition, SchemaArray[Index].NameSpace);
      end;

      { Add seperate schema nodes for each unique URI }
      for Count := 0 to UniqueURI.Count -1  do
      begin
        SchemaDef := WSDLDoc.Definition.Types.SchemaDefs.Add('',UniqueURI.Strings[Count]);
        for Index := 0 to Length(SchemaArray) -1 do
        begin
          if Assigned(FOnPublishingType) then
            FOnPublishingType(Self, SchemaDef, SchemaArray[Index].TypeInfo, UniqueURI.Strings[Count]);
          GenerateXMLSchema(SchemaDef, SchemaArray[Index].TypeInfo, nil, UniqueURI.Strings[Count]);
        end;
      end;
    finally
      UniqueURI.Free;
    end;
  end;
end;

{ NOTE: Consider TOrdType and TFloatType subtypes of tkInteger and tkFloat... }
{ share with TypeTrans.pas ?? }
function TWebServExp.GetXMLSchemaType(const ParamTypeInfo: PTypeInfo):string;
var
  TypeName, URI, Prefix: WideString;
begin

  Prefix := '';
  case ParamTypeInfo^.Kind of
  tkClass, tkDynArray, tkEnumeration, tkSet:
    begin
      { See if it's a predefined XML Schema Type }
      RemTypeRegistry.TypeInfoToXSD(ParamTypeInfo, URI , TypeName);
      { Here if the URI did not match XMLNamespaces, we're dealing with a non-predefined XML Type }