Войти на сайт с TwebBrowser, но не с TidHTTP

Question

Могу ли я попросить небольшую помощь с помощью Indy для входа на сайт, пожалуйста?

Во-первых, так же, как «доказательство концепции» Я использовал 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); 

Но все это возвращает это «Ошибка сервера, 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; 

Только в случае существует некоторое значение в версиях, они «libeay32.dll» v1.0.1.3 в SSL библиотеки DLL и 'ssleay32.dll', также v1.0.1.3.

Могу ли я попросить вас о помощи, понимая, что я пропустил или сделал неправильно, что мешает мне войти в этот сайт с помощью TidHTTP?

Answer 1

Хорошо, нашел вашу проблему. Сайт выполняет переадресацию на ту же страницу после запроса входа в систему POST. Ключом к решению является установка HandleRedirects в значение True и изменение переменной VMethod для GET в событии OnHandleRedirect. Я немного почистил код:

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.