wsdlpub.pas

delphi7 webservice soap 补丁

procedure WSDLPubFactory(out obj: TObject);
begin
  obj := TWSDLPublish.Create;
end;

procedure TWSDLPublish.GetPortTypeEntries(var Entries: TInvRegIntfEntryArray);
var
  I, J, Count, AllIntf: Integer;
  Entry: InvRegIntfEntry;
begin
  AllIntf := InvRegistry.GetInterfaceCount;
  Count := 0;
  for I := 0 to AllIntf do
  begin
    if InvRegistry.HasRegInterfaceImpl(I) then
      Inc(Count);
  end;

  SetLength(Entries, Count);
  J := 0;
  for I:= 0 to AllIntf-1 do
  begin
    { Skip non-implemented classes }
    if not InvRegistry.HasRegInterfaceImpl(I) then
      continue;

    { Put the built-in publisher last }
    Entry := InvRegistry.GetRegInterfaceEntry(I);
    if Entry.Info = TypeInfo(IWSDLPublish) then
      Entries[Count-1] := Entry
    else
    begin
      Entries[J] := Entry;
      Inc(J);
    end;
  end;
end;

{ TWSDLHTMLPublish }

constructor TWSDLHTMLPublish.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWebDispatch := TWebDispatch.Create(Self);
  FWebDispatch.PathInfo := 'wsdl*';
  FWebDispatch.MethodType := mtAny;
  PublishOptions := [];
  AdminEnabled := False;
end;

destructor TWSDLHTMLPublish.Destroy;
begin
  inherited Destroy;
  FWebDispatch.Free;
end;


function TWSDLHTMLPublish.DispatchEnabled: Boolean;
begin
  Result := FWebDispatch.Enabled;
end;

function TWSDLHTMLPublish.DispatchMask: TMask;
begin
    Result := FWebDispatch.Mask;
end;

function TWSDLHTMLPublish.DispatchMethodType: TMethodType;
begin
   Result := FWebDispatch.MethodType;
end;


function TWSDLHTMLPublish.HandleRequest(Resp: TStringList; const Path: String;
                                        const HostScriptBaseURL: String;
                                        var ContentType: String;
                                        Request: TWebRequest): integer;
var
  Pub: TWSDLPublish;

  procedure AddAdmin(const URL: string);
  begin
    Resp.Add('<FORM NAME="admin" METHOD="GET" ACTION=' + '"' + URL + '"' + '>'); { do not localize }
    Resp.Add('<INPUT TYPE="SUBMIT" VALUE="' + sAdminButtonCation + '">');
    Resp.Add('</FORM>');                                     { do not localize }
  end;

  function getDefaultPortValue(Name: string): string;
  begin
    Result := HostScriptBaseURL + '/soap/' + Name;    { Do not localize }
  end;

  function getDefaultPortKey(Name: string): string;
  begin
    Result := Name + 'Port';                          { Do not localize }
  end;

  procedure CreateDefaultEntries;
  var
    I: Integer;
    Entries: TInvRegIntfEntryArray;
    IniFile: TMemIniFile;
  begin
    if not FileExists(AdminIniFile) then
    begin
      IniFile := TMemIniFile.Create(AdminIniFile);
      try
        Pub.GetPortTypeEntries(Entries);
        for I := 0 to Length(Entries) - 1 do
        with Entries[I] do
          IniFile.WriteString(Name, getDefaultPortKey(Name), getDefaultPortValue(Name));  { do not localize }
        if AdminEnabled then
          IniFile.UpdateFile;
      finally
        IniFile.Free;
      end;
    end;
  end;

  procedure NewServicePortForm;
  begin
    Resp.Add('<FORM NAME="admin" METHOD="GET" ACTION=' + '"' + { do not localize }
             HostScriptBaseURL + Path + '"' + '>');          { do not localize }
    Resp.Add('<table ' + TableStyle + '>');                  { do not localize }
    Resp.Add('<tr>');                                        { do not localize }
    AddElem(Resp, sPortNameHeader, sTblHdrCls);
    AddElem(Resp, sAddressHeader, sTblHdrCls);
    Resp.Add('</tr>');                                       { do not localize }
    Resp.Add('<tr>');                                        { do not localize }
    AddElem(Resp, '<INPUT TYPE="TEXT" NAME="' + sPortName + '" SIZE="20" VALUE="" MAXLENGTH="4096">', sTblRow); { do not localize }
    AddElem(Resp, '<INPUT TYPE="TEXT" NAME="' + sAddress + '" SIZE="40" VALUE="" MAXLENGTH="4096">', sTblRow); { do not localize }
    Resp.Add('</tr>');                                       { do not localize }
    Resp.Add('</table>');                                    { do not localize }
    Resp.Add('<p>');                                         { do not localize }
    Resp.Add('<INPUT TYPE="SUBMIT" VALUE="' + sAddButtonCaption + '" NAME="COMMAND_ADD">'); { do not localize }
    Resp.Add('<INPUT TYPE="SUBMIT" VALUE="' + sDeleteButtonCaption + '" NAME="COMMAND_REMOVE">'); { do not localize }
    Resp.Add('</FORM>');                                     { do not localize }
  end;

  procedure GetServicePorts(PortType: string);
  var
    I: Integer;
    IniFile: TMemIniFile;
    PortList: TStringList;
  begin
    IniFile := TMemIniFile.Create(AdminIniFile);
    try
      { If the section exists, use what's there}
      if IniFile.SectionExists(PortType) then
      begin
        PortList := TStringList.Create;
        try
          IniFile.ReadSectionValues(PortType, PortList);
          Pub.PortNames := nil;
          Pub.Locations := nil;
          SetLength(Pub.PortNames, PortList.Count);
          SetLength(Pub.Locations, PortList.Count);
          for I := 0 to PortList.Count - 1 do
          begin
            Pub.PortNames[I] := PortList.Names[I];
            Pub.Locations[I] := PortList.Values[PortList.Names[I]];
          end;
        finally
          PortList.Free;
        end;
      end
      else
      { Here there was nothing for this PortType in the .INI file...
        So we create at least one default so we have something for
        the address location }
      begin
        Pub.PortNames := nil;
        Pub.Locations := nil;
        SetLength(Pub.PortNames, 1);
        SetLength(Pub.Locations, 1);
        Pub.PortNames[0] := getDefaultPortKey(PortType);
        Pub.Locations[0] := getDefaultPortValue(PortType);
      end;
    finally
      IniFile.Free;
    end;
  end;

var
  LastName, PreName: string;
  WSDL: string;
  WSDLBaseURL: String;

begin
  Result   := 200;
  LastName := Copy(Path, LastDelimiter('/', Path) + 1, High(Integer));
  PreName  := Copy(Path, 1, LastDelimiter('/', Path) - 1);
  PreName  :=  Copy(PreName, LastDelimiter('/', PreName) + 1, High(Integer));
  WSDLBaseURL := HostScriptBaseURL + Path;
{$IFDEF MSWINDOWS}
  CoInitialize(nil);
{$ENDIF}
  try
    Pub :=  TWSDLPublish.Create;
    try
      Pub.TargetNamespace := TargetNamespace;
      Pub.OnBeforePublishingWSDL := FOnBeforePublishingWSDL;
      Pub.OnBeforePublishingTypes := FOnBeforePublishingTypes;
      Pub.OnPublishingType := FOnPublishingType;
      Pub.OnAfterPublishingWSDL := FOnAfterPublishingWSDL;

      CreateDefaultEntries;
      if LastName = 'wsdl' then                              { do not localize }
      begin
        Resp.Add(Format(HTMLTopTitleNoMargin, [ServiceName]) +
                        InfoTitle1 +
                        Format(InfoTitle2, [ServiceName, sWebServiceListing]));
        Resp.Add('<center><br>');                            { do not localize }
        AddInterfaceList(Resp, WSDLBaseURL);
        if AdminEnabled then
          AddAdmin(WSDLBaseURL + '/' + 'admin');             { do not localize }
        Resp.Add('</center>');                               { do not localize }
        Resp.Add(HTMLEnd);
        ContentType := sTextHtml;
      end
      else if LastName = 'admin' then                        { do not localize }
      begin
        if not AdminEnabled then
        begin
          Result := 403;
          Resp.Add(sForbiddenAccess);
          ContentType := sTextHtml;
          Exit;
        end;

        Resp.Add(Format(HTMLTopTitle, [sWebServiceListingAdmin]));
        Resp.Add('<h1>' + sWebServiceListingAdmin + '</h1><p>'); { do not localize }
        AddInterfaceList(Resp, WSDLBaseURL);
        Resp.Add(HTMLEnd);
        ContentType := sTextHtml;
      end
      else
      begin
        if PreName = 'wsdl' then                             { do not localize }
        begin
          GetServicePorts(LastName);
          WSDL := Pub.GetWSDLForPortType(LastName);
          if WSDL <> '' then
          begin
            Resp.Add(UTF8Encode(WSDL));
            ContentType := sTextXML;
          end
          else
          begin
            { interface not found... }
            Resp.Add(Format(sInterfaceNotFound, [LastName]));
            ContentType := sTextHtml;
          end;
        end
        else if PreName = 'admin' then                       { do not localize }
        begin
          if not AdminEnabled then
          begin
            Result := 403;
            Resp.Add(sForbiddenAccess);
            ContentType := sTextHtml;
            Exit;
          end;
          if Request.QueryFields.Values['COMMAND_ADD'] <> '' then
            UpdatePortList(Request.QueryFields, LastName, 'ADD')  { do not localize }
          else if Request.QueryFields.Values['COMMAND_REMOVE'] <> '' then
            UpdatePortList(Request.QueryFields, LastName, 'Remove');  { do not localize }
          Resp.Add(Format(HTMLTopTitle, [sWSDLPortsforPortType]));
          Resp.Add('<h1>' + sWSDLPortsforPortType + ' ' + LastName + '</h1><p>'); { do not localize }
          AddPortList(Resp, LastName);
          Resp.Add('<p>');                          { do not localize }
          NewServicePortForm;
          Resp.Add(HTMLEnd);                        { do not localize }
          ContentType := sTextHtml;
        end;
      end;
    finally
      Pub.Free;
    end;
  finally
{$IFDEF MSWINDOWS}
    CoUnInitialize;
{$ENDIF}
  end;
end;

function TWSDLHTMLPublish.DispatchRequest(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse): Boolean;
var
  Resp: TStringList;
  Path: string;
  HostScriptBaseURL: String;
  ContentType: String;
begin
  try
    HostScriptBaseURL := GetHostScriptBaseURL(Request);
    Path := Request.InternalPathInfo;
    { Strip ending '/' }
    if Path[Length(Path)] = '/' then
      Path := Copy(Path, 1, Length(Path)-1);
{$IFDEF MSWINDOWS}
    CoInitialize(nil);
{$ENDIF}
    try
      Resp := TStringList.Create;
      try
        Response.StatusCode := HandleRequest(Resp, Path, HostScriptBaseURL, ContentType, Request);
        Response.ContentType := ContentType;
        Response.Content := Resp.Text;
      finally
        Resp.Free;
      end;
    finally
{$IFDEF MSWINDOWS}
      CoUnInitialize;
{$ENDIF}
    end;
  except
    on E: Exception do
    begin
      Response.Content := HTMLTop+'<h1>' + sErrorColon + E.Message + '/'+ E.ClassName+'</h1>'+HTMLEnd; { do no localize }
      Response.ContentType := sTextHtml;
    end
    else
    begin
      Response.Content := HTMLTop+'<h1>'+sUnknownError +'</h1>'+HTMLEnd; { do not localize }
      Response.ContentType := sTextHtml;
    end;
  end;
  Result := True;
end;

procedure TWSDLHTMLPublish.ServiceInfo(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);

const
  IntfHdr     = '<br><table width="100%" border=0 cellpadding=1 cellspacing=0>'            + sLineBreak;
  IntfSectBig = '<tr><td width="1%" class="Info">&nbsp;</td><td width="99%" class="Info">' + sLineBreak;
  IntfSect    = '<tr><td width="1%">&nbsp;</td><td width="99%">'                           + sLineBreak;
  IntfSectEnd = '</td></tr>'                                                               + sLineBreak +
                '<tr><td>&nbsp;</td><td>&nbsp;</td></tr>'                                  + sLineBreak;

  IntfBeg = '<tr>' +
            '<td width="1%">&nbsp;</td>' +
            '<td width="99%">' +
            '<ul>';
  IntfEntL= '<li>'                                                                     + sLineBreak +
            '<a class="IntfName" href="%1:s?' + sQueryStringIntf + '=%0:s">%0:s</a>'   + sLineBreak;
  IntfEntP= '<li>'                                                                     + sLineBreak +
            '<span class="IntfName">%0:s</span>'                                       + sLineBreak;

  IntfWSDL= '<span class="WSDL">[</span>'                                              +
            '<a class="WSDL" href="%s">WSDL</a>'                                       +
            '<span class="WSDL">]</span>'                                              + sLineBreak;
  IntfNS =  '&nbsp;<span class="Namespace">(%0:s)</span>'                              + sLineBreak;
  IntDoc1=  '<table><tr><td width="2%">&nbsp;</td><td>'                                + sLineBreak;
  IntDoc2=  '<span class="Tip">%s</span></td></tr></table>'                            + sLineBreak;
  MethBeg=  '<ul>';
  MethEnt=  '<li><span class="MethName">%s</span></li>';
  MethEnd=  '</ul>';