如何在 SOAP 接口调用的 Http header 中增加字段

在 Delphi 中添加 SOAP Header 就不用说了，请参考 Delphi 自带示例，位于 Demos/WebServices/SOAPHeaders 目录下。添加 Http header 字段示例如下。

示例 WSDL 文件描述如下：

  SampleServiceSoap = class(IInvokable)
  ['{08323867-2307-4569-8405-4E575CC3C453}']
    procedure SampleProcedure1;
    procedure SampleProcedure2;
  end;

function GetSampleServiceSoap(UseWSDL: Boolean; Addr: string; HTTPRIO: THTTPRIO): SampleSoap;
const
  defWSDL = 'http://127.0.0.1/SampleService.asmx?WSDL';
  defURL  = 'http://127.0.0.1/SampleService.asmx';
  defSvc  = 'SampleService';
  defPrt  = 'SampleServiceSoap';
var
  RIO: THTTPRIO;
begin
  Result := nil;
  if (Addr = '') then
  begin
    if UseWSDL then
      Addr := defWSDL
    else
      Addr := defURL;
  end;
  if HTTPRIO = nil then
    RIO := THTTPRIO.Create(nil)
  else
    RIO := HTTPRIO;
  try
    Result := (RIO as SampleServiceSoap);
    if UseWSDL then
    begin
      RIO.WSDLLocation := Addr;
      RIO.Service := defSvc;
      RIO.Port := defPrt;
    end else
      RIO.URL := Addr;
  finally
    if (Result = nil) and (HTTPRIO = nil) then
      RIO.Free;
  end;
end;

增加 Http header 示例如下：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SOAPHTTPTrans, SOAPHTTPClient, ActiveX;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure BeforePost(const HTTPReqResp: THTTPReqResp; Data: Pointer);
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// 在发送请求之前在 http header 中添加 CustomHeader 字段
// Data 是指向 HINTERNET 类型的指针
procedure TForm1.BeforePost(const HTTPReqResp: THTTPReqResp;
  Data: Pointer);
const
  csCustomHeader = 'CustomHeader:XXXXXXXX'
begin
  HttpAddRequestHeaders(Data, PChar(csCustomHeader), Length(csCustomHeader),
    HTTP_ADDREQ_FLAG_ADD);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Soap: SampleServiceSoap;
  RIO: THTTPRIO;
begin
  CoInitialize(nil);
  RIO := THTTPRIO.Create(nil);
  try
    RIO.HTTPWebNode.OnBeforePost := BeforePost;
    Soap := GetSampleServiceSoap(False, 'http://127.0.0.1/SampleService.asmx', RIO);
    if Assigned(Soap) then
      Soap.SampleProcedure1;
  finally
    RIO.Free;
    CoUninitialize;
  end;
end;

end.