Delphi调用WebService（通过SoapHeader认证）经验总结
项目（Delphi开发）需要调用另一个系统的WebService。走了不少弯路，现记录总结一下经验。以下是WebService要求：
1、WebService概述
营销Webservice接口采用Apache Axis（version 1.4）技术实现。客户端和服务器用SOAP（Simple Object Access Protocol）协议通过HTTP来交互，客户端根据WSDL描述文档生成SOAP请求消息发送到服务端，服务端解析收到的SOAP请求，调用Web service，然后再生成相应的SOAP应答送回到客户端。
2 、认证机制
营销的所有Webservice服务均需要认证通过（部分需要授权）才能够被调用。营销Webservice服务接收到请求后从Soap头中获取用户名和密码，进行认证，认证通过后再调用具体服务。
作为客户端，应用程序代码(使用Axis的客户端编程模型来编写的)需要将用户名和密码设置到SOAPHeader中。SOAPHeaderElement的namespace约定为Authorization，localPart约定为username 和 password。
根据客户端程序语言及调用方式不同，设置的方法也不同，下面示例说明客户端程序语言为java调用方式为动态调用的设置方法：用org.apache.axis.client.Call 的addHeader方法：
call.addHeader(new SOAPHeaderElement("Authorization","username",username));
call.addHeader(new SOAPHeaderElement("Authorization","password",password));
其他的调用方式及其他语言设置方式请查阅Axis相关文档。
最终传输的SOAP报文格式如下：
最终传输的SOAP头信息如下：
<soapenv:Header> <ns1:username soapenv:actor="http://schemas.xmlsoap.org/soap/actor/next" soapenv:mustUnderstand="0" xsi:type="soapenc:string" xmlns:ns1="Authorization" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"> username </ns1:username> <ns2:password soapenv:actor="http://schemas.xmlsoap.org/soap/actor/next" soapenv:mustUnderstand="0" xsi:type="soapenc:string" xmlns:ns2="Authorization" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"> password </ns2:password> </soapenv:Header>
开始的时候，按照一般调用WebService方法进行：导入wsdl，自动生成WebService调用函数，手工添加一个类继承TSOAPHeader类，使用HTTPRIO发送SOAP报文。但是使用SOAPUI测试发出的报文，发现SoapHeader信息和WebService要求的格式不一样。
于是想到，在soap报文发出前，手动将soap报文改成WebService要求的格式，即在HTTPRIO的BeforeExecute事件中修改soap报文：
procedure TForm1.HTTPRIO1BeforeExecute(const MethodName: String; var SOAPRequest: WideString); var head_begin,head_end,head_len: Integer; SOAPData: WideString; old_head: WideString; begin SOAPData := SOAPRequest; //替换SOAP头 head_begin := Pos('<SOAP-ENV:Header',SOAPData); head_end := Pos('</SOAP-ENV:Header>',SOAPData); head_len := head_end + Length('</SOAP-ENV:Header>') - head_begin; old_head := Copy(SOAPData,head_begin,head_len); SOAPData := StringReplace(SOAPData,old_head,NewSoapHeader,[rfReplaceAll, rfIgnoreCase]); //转义字符处理 < 改 < SOAPData := StringReplace(SOAPData,'<','<',[rfReplaceAll, rfIgnoreCase]); //转义字符处理 > 改 > SOAPData := StringReplace(SOAPData,'>','>',[rfReplaceAll, rfIgnoreCase]); SOAPRequest := SOAPData; Memo2.Clear; Memo2.Lines.Add(Utf8ToAnsi(SOAPRequest)); end;
但是，用SoapUI测试，发现这样修改后发出的报文Header没有了，只有Body部分。
仔细研究了一下Delphi的Soap相关控件，最终找到以下解决方法使用THTTPReqResp控件直接发送完整的soap报文，相关代码如下：
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,IniFiles, DB, ADODB, StdCtrls, InvokeRegistry, Rio, SOAPHTTPClient,GenericServer1, ExtCtrls,ActiveX, SOAPHTTPTrans; const SOAP_DATA = '<?xml version="1.0"?>' + '<SOAP-ENV:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema" ' + ' xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/">' + '<SOAP-ENV:Header>' + '<ns1:username SOAP-ENV:actor="http://schemas.xmlsoap.org/soap/actor/next" SOAP-ENV:mustUnderstand="0" xsi:type="soapenc:string" xmlns:ns1="Authorization" ' + 'xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/">' + ':WS_USER_NAME' + '</ns1:username>' + '<ns2:password SOAP-ENV:actor="http://schemas.xmlsoap.org/soap/actor/next" SOAP-ENV:mustUnderstand="0" xsi:type="soapenc:string" xmlns:ns2="Authorization" ' + 'xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/">' + ':WS_PASSWORD' + '</ns2:password>' + '</SOAP-ENV:Header>' + '<SOAP-ENV:Body SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' + '<NS2:invoke xmlns:NS2="http://server.webservice.core.epm">' + '<path xsi:type="xsd:string">:WS_PATH</path>' + '<methodName xsi:type="xsd:string">:WS_METHOD_NAME</methodName>' + '<dataXmlStr xsi:type="xsd:string">' + '<![CDATA[' + ':WS_XML_DATA' + ']]>' + '</dataXmlStr>' + '</NS2:invoke>' + '</SOAP-ENV:Body>' + '</SOAP-ENV:Envelope>'; type TForm1 = class(TForm) ADOConnection1: TADOConnection; GroupBox8: TGroupBox; Label21: TLabel; Label22: TLabel; Label23: TLabel; Label24: TLabel; Label25: TLabel; edt_wsdl_url: TEdit; edt_path: TEdit; edt_method: TEdit; edt_user: TEdit; edt_password: TEdit; Button1: TButton; Memo1: TMemo; Label1: TLabel; Label2: TLabel; Memo2: TMemo; Timer_Ping: TTimer; HTTPReqResp1: THTTPReqResp; procedure FormCreate(Sender: TObject);procedure Button1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Timer_PingTimer(Sender: TObject); private { Private declarations } public { Public declarations } NETWORK_ID, NETWORK_NAME, WSDL_URL, USER_NAME, PASSWORD, METHOD_NAME, PATH: WideString; dataXmlStr: WideString; NewSoapData: WideString; procedure sendData(); end; { 使用线程发送WebService } TPingThread = class(TThread) protected procedure execute; override; end; procedure write_log(str: string);//写入记录文件 var Form1: TForm1; { 初始化临界区CS变量 } PingCS:TRTLCriticalSection; implementation uses util_utf8; {$R *.dfm} procedure write_log(str: string); var F: TextFile; mfile: string; begin try //判断保存日志文件的目录是否存在 if not DirectoryExists(ExtractFilePath(ParamStr(0)) + 'log') then MkDir(ExtractFilePath(ParamStr(0)) + 'log'); //按日期及时间设定保存日志的文件名 mfile := ExtractFilePath(ParamStr(0)) + 'log\' + formatdatetime('yyyy-mm-dd', now) + '.txt'; AssignFile(F,mfile); if not FileExists(mfile) then Rewrite(F);//如果文件不存在，则创建一个新的文件，并写入 Append(F); //追加写入 Writeln(F,str);//写入并换行 CloseFile(F); except end; end; //读txt Procedure ReadTxt(FileName:String); Var F:Textfile; str: String; Begin AssignFile(F, FileName); {将文件名与变量 F 关联} Reset(F); {打开并读取文件 F } while not Eof(F) do begin Readln(F, str); Form1.Memo2.Lines.Add(str); end; ShowMessage(str); Closefile(F); {关闭文件 F} End; procedure TForm1.FormCreate(Sender: TObject); begin InitializeCriticalSection(PingCS); end; //发送 procedure TForm1.Button1Click(Sender: TObject); begin Timer_Ping.Enabled := True; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin { 清除线程CS变量 } DeleteCriticalSection(PingCS); end; procedure TForm1.Timer_PingTimer(Sender: TObject); begin { 创建线程, 向LED屏发送数据 } TPingThread.Create(False); end; procedure TForm1.sendData; var svc: GenericServer; tmpstr: string; strSend: TStringStream; begin WSDL_URL := Trim(edt_wsdl_url.Text); USER_NAME := Trim(edt_user.Text); PASSWORD := Trim(edt_password.Text); METHOD_NAME := Trim(edt_method.Text); PATH := Trim(edt_path.Text); dataXmlStr := Trim(Memo1.Text); //获取自定义soap报文 NewSoapData := SOAP_DATA; NewSoapData := StringReplace(NewSoapData,':WS_USER_NAME',USER_NAME,[rfReplaceAll, rfIgnoreCase]); NewSoapData := StringReplace(NewSoapData,':WS_PASSWORD',PASSWORD,[rfReplaceAll, rfIgnoreCase]); NewSoapData := StringReplace(NewSoapData,':WS_PATH',PATH,[rfReplaceAll, rfIgnoreCase]); NewSoapData := StringReplace(NewSoapData,':WS_METHOD_NAME',METHOD_NAME,[rfReplaceAll, rfIgnoreCase]); NewSoapData := StringReplace(NewSoapData,':WS_XML_DATA',dataXmlStr,[rfReplaceAll, rfIgnoreCase]); Memo2.Text := NewSoapData; //使用HTTPReqResp1控件进行发送soap报文，不适用HTTPRIO控件（发出的报文xml会被转义，也不需要导入wsdl了） CoInitialize(nil); //线程中使用必须加上CoInitialize(nil)和CoUninitilize()， 单元中要uses activex。 //将string转换成stream strSend := TStringStream.Create(NewSoapData); try try //加上try。。except，不要弹出爆粗提示 HTTPReqResp1.URL := WSDL_URL; HTTPReqResp1.Send(strSend); except on e:Exception do begin write_log(FormatDateTime('yyyy-mm-dd hh:nn:ss',Now) + ' 调用WebService时发生异常，错误原因：'+E.Message); end; end; finally strSend.Free; couninitialize; end end; { TPingThread } procedure TPingThread.execute; begin Form1.Timer_Ping.Enabled :=false; FreeOnTerminate := True; {线程临界区代码块开始} EnterCriticalSection(PingCS); try form1.sendData; {线程临界区代码块结束} except on e:Exception do begin write_log(FormatDateTime('yyyy-mm-dd hh:nn:ss',Now) + ' TPingThread.execute：'+E.Message); end; end; LeaveCriticalSection(PingCS); end; end.
测试效果，可以发现，发出的报文和接收的报文是一致的：
源码下载：https://files.cnblogs.com/files/tc310/WebServiceDemo.rar
