我在人群中四处张望，想拉住你伤心的眼光。你说你刚与我擦肩而过，我竟没有留意你随风而逝的发香。

导航

[原创]用Http协议给网页服务器发送数据并取得结果内容

Posted on 2005-08-02 16:36  灰辉  阅读(1614)  评论(0)    收藏  举报

    昨天公司让做一个小东东，需求如下：

    一个网页（http://app1.sda.gov.cn/webportal/portal.po?UID=DWV1_WOUID_URL_6646923&&hsearchOption=clientSearch&hsearchSubOption=searchResult）上面有个表单，表单里有个下拉框和一个输入框，method为“POST”。要求用软件实现在网页上输入时相同的效果，并取回结果表格里的内容，保存到MySql里。返回值的网页在当前页面打开，并且Form的action仍为上述地址。图片如下：

提交前：


提交后：

    
    刚开始，我考虑用WebBrowser控件，打开这个网页后，得到其中的下拉框和输入框对象，赋值后提交这个表单。程序里涉及到以下几个接口：
IHTMLDocument2
IHTMLElementCollection
IHTMLElement
IHTMLFormElement
IHTMLInputElement
IHTMLSelectElement

我用 Doc:=WebBrowser1.Document as IHTMLDocument2 得到把打开后的页面做为实现IHTMLDocument2 接口的对象来处理。这是一个与诸多网页内容相关的接口，如 Doc.frames.length 表示网页的框架个数，Doc.body.OuterText可以得到页面的源代码，aElementCollection:=Doc.GetAll返回页面上所有的对象（或元素）等。Dispatch:=aElementCollection.Item()方法以元素名字或索引来引用某个元素（Dispatch为一个IDispatch接口变量）。例如，可以用以下语句
    if SUCCEEDED(Dispatch.QueryInterface(IHTMLFormElement,HTMLFormElement))then...
来检查网页上是否存在表单（HTMLFormElement是一个IHTMLFormElement接口变量）。如果存在，则检查表单的名称是否为要求的值：
    if HTMLFormElement.name='frmClientSearch' then ...
如果都符合条件，则可用
    HTMLFormElement.submit
方法向服务器提交这个表单。

    实际编写程序时，遇到了两个问题：
    1、当把取得结果页面的源代码的代码放在按钮事件里时，表单处理地址和当前页面地址一样，并且提交后仍然返回当前页面的地址。提交后，WebBrowser1.LocationURL 得到的不再是原来的地址，并且用
   while WebBrowser1.ReadyState <READYSTATE_COMPLETE  do  Application.ProcessMessages
等待页面显示完毕时不起作用，把代码放在WebBrowser1的OnDocumentComplete事件里可以得到。
    2、速度太慢，因为要下载整个网页。

    于是放弃这种方法，考虑采用IdHTTP控件来直接向服务器POST表单数据。
    打开 WSockExpert ，找到刚才用WebBrowser1编写的程序（直接监视IE数据时，由于滚动太快，抓不住POST请求的数据包。显示内容的列表不能向上滚动，而是把最开始的记录覆盖了，估计是软件的bug，毕业用的是beta版本），提交一次，找到记录下来的如下内容：

POST /webportal/portal.po?UID=DWV1_WOUID_URL_6646923&amp;&&&hsearchOption=clientSearch&hsearchSubOption=searchResult HTTP/1.1
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, application/x-shockwave-flash, */*
Referer: http://app1.sda.gov.cn/webportal/portal.po?UID=DWV1_WOUID_URL_6646923&amp;&&hsearchOption=clientSearch&hsearchSubOption=searchResult
Accept-Language: zh-cn
Content-Type: application/x-www-form-urlencoded
Accept-Encoding: gzip, deflate
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)
Host: app1.sda.gov.cn
Content-Length: 38
Connection: Keep-Alive
Cache-Control: no-cache

ListSelect=TBL_TABLE283&searchClient=1

其中 ListSelect 即为表单上下拉框的名字，TBL_TABLE283 是其值；searchClient 是输入框的名字，“1”是输入的要查询的内容。
从上面我们看到提交表单后，用POST方式向服务器发送了 ListSelect=TBL_TABLE283&searchClient=1 这么一些信息。于是很自然地用IdHTTP控件向这个地址发送这些内容即可达到目的。
    往窗体上拖一个 IdHTTP 控件，属性不用更改。源代码如下：

unit frmGetInfo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls, IdAntiFreezeBase, IdAntiFreeze, ComCtrls, ExtCtrls, DB,
  MemDS, DBAccess, MyAccess;

type
  TProgressInfo=record
    Verify_Code:string;//核对码
    Accept_case_code:string;//受理号
    Corp_name:string;//企业名称
    Transact_State:string;//办理状态
    Drug_Approve_Code:string;//药品批准文号
    State_date:string;//状态开始时间
    Notice_date:string;//通知时间
    Notice_content:string;//通知内容
    Charge_Circs:string;//收费情况
    Charge_date:string;//费用收到日期
    Checkout_report_date:string;//检验报告收到日期
    Criterion_hodometer_date:string;//标准品回执收到日期
  end;

type
  TGetInfo = class(TForm)
    http: TIdHTTP;
    btnSearch: TButton;
    IdAntiFreeze1: TIdAntiFreeze;
    ProgressBar1: TProgressBar;
    GroupBox1: TGroupBox;
    edtVerify_Code: TLabeledEdit;
    edtAccept_case_code: TLabeledEdit;
    edtCorp_name: TLabeledEdit;
    edtTransact_State: TLabeledEdit;
    edtDrug_Approve_Code: TLabeledEdit;
    edtState_date: TLabeledEdit;
    edtNotice_date: TLabeledEdit;
    edtNotice_content: TLabeledEdit;
    edtCharge_Circs: TLabeledEdit;
    edtCharge_date: TLabeledEdit;
    edtCheckout_report_date: TLabeledEdit;
    edtCriterion_hodometer_date: TLabeledEdit;
    btnClose: TButton;
    procedure httpWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure httpWork(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure btnSearchClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
  private
    { Private declarations }
    FResultInfo:TProgressInfo;
    FSuccess:boolean;
    procedure DoSetEditValue;
  public
    { Public declarations }
    Verify_Code:string;
    function CheckConnection(sURL:string):boolean;
    function GetProgressInfo(sVerify_Code:string):TProgressInfo;
    function SaveToDb(aMyQuery:TMyQuery):boolean;
  end;

resourcestring
  PostURL='http://app1.sda.gov.cn/webportal/portal.po?UID=DWV1_WOUID_URL_6646923&amp;&hsearchOption=clientSearch&hsearchSubOption=searchResult';
  UpdateSql='update Corp_reg_Config set Accept_case_code=''%s'',Corp_name=''%s'',Transact_State=''%s'','+
            'Drug_Approve_Code=''%s'', State_date=''%s'',Notice_date=''%s'',Notice_content=''%s'',Charge_Circs=''%s'','+
            'Charge_date=''%s'',Checkout_report_date=''%s'',Criterion_hodometer_date=''%s'' '+
            'where Verify_Code=''%s''';

var
  GetInfo: TGetInfo;

implementation

{$R *.dfm}

{ TGetInfo }

function TGetInfo.CheckConnection(sURL: string): boolean;
begin
  result:=false;
  try
    http.Head(sURL);
    if pos('200 OK', http.Response.ResponseText)>0 then
      result:=true;
  except
  end;
end;

function TGetInfo.GetProgressInfo(sVerify_Code: string): TProgressInfo;
var
  sHead, sResult: TStringStream;
  sResultContent:String;
  Inicial,Final: Integer;
  function GetValue:string; //取得 '</SPAN>' 之前的字符串
  var
    t:integer;
  begin
    delete(sResultContent,1,pos('<SPAN id="Content">',sResultContent)+18);
    result:='';
    t:=pos('</SPAN>',sResultContent);
    result:=copy(sResultContent,1,t-1);
  end;
begin
  //检查地址是否有效
  if not CheckConnection(PostURL) then
  begin
    application.MessageBox('连接服务器失败，请检查网络是否连通！','失败',MB_ICONWARNING);
    exit;
  end;
  FSuccess:=false;
  sHead := TStringStream.Create('');
  sResult := TStringStream.Create('');
  sHead.WriteString('ListSelect=TBL_TABLE283&searchClient='+sVerify_Code);
  http.Request.ContentType := 'application/x-www-form-urlencoded';
  try
    http.Post(PostURL, sHead, sResult)
  except
    http.Get(http.Response.Location, sResult);
  end;
  Inicial := Pos('<TABLE><TR><TD><SPAN id="Message">',sResult.DataString);    //获得返回结果表格字符串的开头
  Final   := Pos('</TD></TR></TABLE></FORM></TD></TR></TABLE></DIV>',sResult.DataString);  //获得结果表格的结尾
  sResultContent := Copy(sResult.DataString,Inicial,Final-Inicial);
  sResultContent:= Utf8Toansi(sResultContent);
  if Pos('<SPAN id="dbDescr">',sResultContent)>0 then //如果找到
  begin
    with Result do
    begin
      Verify_Code:=sVerify_Code;//核对码
      Accept_case_code:=GetValue; //受理号
      Corp_name:=GetValue; //企业名称
      Transact_State:=GetValue; //办理状态
      Drug_Approve_Code:=GetValue; //药品批准文号
      State_date:=GetValue; //状态开始时间
      Notice_date:=GetValue; //通知时间
      Notice_content:=GetValue; //通知内容
      Charge_Circs:=GetValue; //收费情况
      Charge_date:=GetValue; //费用收到日期
      Checkout_report_date:=GetValue; //检验报告收到日期
      Criterion_hodometer_date:=GetValue; //标准品回执收到日期
    end;
    FSuccess:=true;
  end
  else
  begin
    application.MessageBox('没有找到要查询的数据','失败',MB_ICONWARNING);
  end;
end;

procedure TGetInfo.httpWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  ProgressBar1.Position :=0;
  ProgressBar1.Max :=AWorkCountMax;
end;

procedure TGetInfo.httpWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  ProgressBar1.Position :=AWorkCount;
end;

function TGetInfo.SaveToDb(aMyQuery: TMyQuery): boolean;
begin
  result:=false;
  if FSuccess then
  begin
    with aMyQuery do
    begin
      close;
      sql.Clear;
      with FResultInfo do
        sql.Text :=format(UpdateSql,[Accept_case_code,Corp_name,Transact_State,Drug_Approve_Code,State_date,
                                     Notice_date,Notice_content,Charge_Circs,Charge_date,Checkout_report_date,
                                     Criterion_hodometer_date,Verify_Code]);
      try
        Execute;
        result:=true;
      except
        result:=false;
      end;
    end;
  end
end;

procedure TGetInfo.DoSetEditValue;
begin
  FResultInfo:=GetProgressInfo(Verify_Code);
  with FResultInfo do
  begin
    edtVerify_Code.Text:=Verify_Code;
    edtAccept_case_code.Text:=Accept_case_code;
    edtCorp_name.Text:=Corp_name;
    edtTransact_State.Text:=Transact_State;
    edtDrug_Approve_Code.Text:=Drug_Approve_Code;
    edtState_date.Text:=State_date;
    edtNotice_date.Text:=Notice_date;
    edtNotice_content.Text:=Notice_content;
    edtCharge_Circs.Text:=Charge_Circs;
    edtCharge_date.Text:=Charge_date;
    edtCheckout_report_date.Text:=Checkout_report_date;
    edtCriterion_hodometer_date.Text:=Criterion_hodometer_date;
  end;
end;

procedure TGetInfo.btnSearchClick(Sender: TObject);
begin
  Verify_Code:='1'; //要查询的值，由外部调用者传进来。
  //从服务器查询
  (Sender as TButton).Enabled :=false;
  try
    DoSetEditValue;
  finally
    (Sender as TButton).Enabled :=true;
  end;
{
  //保存
  if SaveToDb() then
  begin
    application.MessageBox('保存数据完成！','成功',MB_ICONINFORMATION);
    close;
  end
  else
  begin
    application.MessageBox('保存数据失败！','失败',MB_ICONWARNING);
  end;
}
end;

procedure TGetInfo.btnCloseClick(Sender: TObject);
begin
  close;
end;

end.


程序界面如下：


（显示的汉字是经过加密后的内容，无关紧要。）