使用 TwebBrowser 可以登录到站点，但不能使用 TidHTTP

Question

我可以请求一些使用 Indy 登录网站的帮助吗？

首先，作为 'proof of concept' 我使用 TWebBrowser 按以下方式测试我的凭据...

procedure TfrmMain.cxButton1Click(Sender: TObject);
begin
  webBrow.Navigate('http://assurance.redtractor.org.uk/rtassurance/services.eb');
end;

procedure TfrmMain.webBrowDocumentComplete(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  CurrentBrowser: IWebBrowser2;
  TopBrowser: IWebBrowser2;
  Document: OleVariant;
  Doc3 :  IHTMLDocument3;
  Frm  :  IHtmlFormElement;

begin
 CurrentBrowser := pDisp as IWebBrowser2;
 TopBrowser := (ASender as TWebbrowser).DefaultInterface;
 if Assigned(CurrentBrowser) and Assigned(TopBrowser) then
   begin
       if CurrentBrowser = TopBrowser then
       begin
         Doc3 := CurrentBrowser.Document as IHTMLDocument3;
         Webbrow.OnDocumentComplete := nil; // remove handler to avoid reentrance
               Doc3.getElementById('el9M9AQXIL51JI3_loginPnl_username').setAttribute('value', 'aValidUserName', 0);
     Doc3.getElementById('el9M9AQXIL51JI3_loginPnl_password').setAttribute('value', 'aValidPassword', 0);
     //Frm := Doc3.getElementById('ct100') as IHtmlFormElement;
     Doc3.GetElementByID('el9M9AQXIL51JI3_loginPnl_button').click();
    end;
  end;
end;

我从 whosrdaddy 的回答中得到了以上内容Automated Log In (webBrowser)

让我登录网站并进入搜索页面...正是我需要的。

但是，我想避免使用 TWebBrowser，因为我认为由于页面需要呈现这一事实，我的搜索会很慢。考虑到这一点，我尝试使用 Indy 10 登录到相同的地址，并像这样传递参数 ...

idRedTractor.Post(login_URL, Request, Response);

但是所有这些 returns 都是 'Server Error, Unauthenticated UserName' 的回应。

我尝试登录的完整代码是...

procedure TfrmMain.btnLogonClick(Sender: TObject);
var
  Response      : TMemoryStream;
  searchResp    : TMemoryStream;
  Request       : TStringList;
  searchReq     : TStringList;
  resultStr     : TStringList;

begin

    with IdRedTractor do
    begin
        allowCookies := true;
        cookieManager := cookieRedTractor;
        IOhandler := IdSSLRedTractor;
        request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
        request.contentType := 'text/html';
        request.userAgent := 'Mozilla/3.0 (compatible; Indy Library)';
    end;

  with IdSSLRedTractor do
  begin
    // SSLOptions does not make a difference. Still get a Server Error message
    SSLOptions.Mode := sslmUnassigned;
    //SSLOptions.Mode := sslmBoth;
    //SSLOptions.Mode := sslmClient;
    //SSLOptions.Mode := sslmServer;
  end;

  try
    try
      response    := TMemoryStream.Create;
      searchResp  := TMemoryStream.Create;
      try
        request   := TStringList.Create;
        searchReq := TStringList.Create;
        resultStr := TStringList.Create;

        // Individual params via FireBug
        Request.Add('__EVENTARGUMENT=login');
        Request.Add('__EVENTTARGET=el9M9AQXIL51JI3$loginPnl');
        Request.Add('__VIEWSTATE=/wEPDwULLTEzMjc3NzQ0ODEPZBYEAgEPZBYCZg9kFgJmDxYCHgRUZXh0BRNDaGVja2VycyAmIFNlcnZpY2VzZAIDD2QWBAICDxYCHgdWaXNpYmxlaGQCCQ9kFgICAg9kFgICBA8WAh8BZxYCAgEPFgIfAWhkZD3T1Ydwd12+6SzZOgVHrnka9LKB');
        Request.Add('__VIEWSTATEGENERATOR=9D5BCA8C');
        Request.Add('ebAbPwd=' + edtUserPass.text);
        Request.Add('ebAbPwd=');
        Request.Add('ebAbUser=' + edtUserName.text);
        Request.Add('ebAbUser=');
        Request.Add('el9M9AQXIL51JI3$loginPnl_...=' + edtUserName.Text);
        Request.Add('el9M9AQXIL51JI3$loginPnl_...=' + edtUserPass.text);
        Request.Add('el9OK3XX11WQS60_email=');{}

        IdRedTractor.Request.Referer := 'http://assurance.redtractor.org.uk/rtassurance/schemes.eb';//initial_URL;
        IdRedTractor.Post('http://assurance.redtractor.org.uk/rtassurance/services.eb', Request, Response);

        if idRedtractor.ResponseCode = 200 then
        begin
          resultStr.Clear;
          Response.Position := 0;
          resultStr.LoadFromStream(Response);
          mmoResponse.Lines.AddStrings(resultStr);
        end;
      finally
        request.Free;
        searchReq.Free;
        resultStr.Free;
      end;
    finally
      response.Free;
      searchResp.Free;
    end;
  except
    on e: Exception do
      showMessage(e.Message);
  end;
end;

只是为了防止 SSL DLL 的版本有一些价值，它们是 'libeay32.dll' v1.0.1.3 和 'ssleay32.dll'，还有 v1.0.1.3。

请问您是否可以帮助我了解我遗漏或做错了什么，导致我无法使用 TidHTTP 登录此站点？

Answer 1

好的，找到你的问题了。该站点在 POST 登录请求后重定向到同一页面。解决的关键是将 HandleRedirects 设置为 True 并将 VMethod 变量更改为 OnHandleRedirect 事件中的 GET。我稍微清理了一下代码：

unit SO35263785Test;

interface

uses
  IdHttp,
  SysUtils,
  StrUtils,
  StdCtrls,
  Classes,
  Controls,
  Forms;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    Client : TIdHttp;
    procedure HandleRedirect(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod);
    procedure LoginToRedTractor(const Username, Password : String);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.HandleRedirect(Sender: TObject; var dest: string; var NumRedirect: Integer; var Handled: boolean; var VMethod: TIdHTTPMethod);
begin
 VMethod := Id_HTTPMethodGet;
 Handled := True;
end;

procedure ExtractViewStateAndGenerator(const Html : String; var ViewState : String; var ViewStateGenerator: String);

var
  Ps : Integer;

begin
 ViewState :=  '';
 ViewStateGenerator := '';
 // we assume __VIEWSTATE and __VIEWSTATEGENERATOR inputs are there, NO error checking
 Ps := Pos('__VIEWSTATE', Html);
 Ps := PosEx('value', Html, Ps);
 Ps := PosEx('"', Html, Ps);
 ViewState := Copy(Html, Ps+1, PosEx('"', Html, Ps+1)-Ps-1);
 Ps := Pos('__VIEWSTATEGENERATOR', Html);
 Ps := PosEx('value', Html, Ps);
 Ps := PosEx('"', Html, Ps);
 ViewStateGenerator := Copy(Html, Ps+1, PosEx('"', Html, Ps+1)-Ps-1);
end;

procedure TForm1.LoginToRedTractor(const Username, Password : String);

var
  GETResponse        : String;
  Request            : TStringList;
  ViewState          : String;
  ViewStateGenerator : String;

begin
 Client := TIdHttp.Create;
 try
  Client.ProtocolVersion := pv1_1;
  Client.HTTPOptions := [hoForceEncodeParams, hoKeepOrigProtocol];
  Client.AllowCookies := True;
  Client.HandleRedirects := True;
  Client.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.3; WOW64)  AppleWebKit/537.36 (KHTML, like Gecko) Chrome/48.0.2564.103 Safari/537.36';
  Client.OnRedirect := HandleRedirect;
  GETResponse :=  Client.Get('http://assurance.redtractor.org.uk/rtassurance/schemes.eb');
  ExtractViewStateAndGenerator(GETResponse, ViewState, ViewStateGenerator);
  Request := TStringList.Create;
  try
   Request.Add('__VIEWSTATE='+ViewState);
   Request.Add('__VIEWSTATEGENERATOR='+ViewStateGenerator);
   Request.Add('__EVENTTARGET=el9M9AQXIL51JI3$loginPnl');
   Request.Add('el9M9AQXIL51JI3$loginPnl_username='+Username);
   Request.Add('el9M9AQXIL51JI3$loginPnl_password='+Password);
   Client.Request.Referer := Client.URL.URI;
   Memo1.Text :=  Client.Post('http://assurance.redtractor.org.uk/rtassurance/services.eb', Request);
  finally
   Request.Free;
  end;
 finally
  Client.Free;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 LoginToRedTractor('MyUsername', 'MyPassword');
end;

end

此代码已经过验证，可在 Delphi XE 中使用。

使用 TwebBrowser 可以登录到站点，但不能使用 TidHTTP

Login OK to site with TwebBrowser , but not with TidHTTP

delphi

web

delphi-xe

indy