比如说百度的登陆网页,有一个用户名文本框,一个输密码的文本框,一个登陆按钮,要用delphi写程序按指定的帐号自动登陆用户,不新建IE浏览器窗口,网络传输全部由程序完成,要如何实现?
如果登陆成功了,在程序中转到百度其他的网页输数据、提交,因为需要已登陆用户才能操作,因而要保持刚刚自动登陆的cookie,要如何进行?

解决方案 »

  1.   

    需要自己用delphi写如asp中的form提交结构,不知道,关注
      

  2.   

    unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls,MSHTML, SHDOCVW,IdGlobal;type
      TMainFrm = class(TForm)
        btnTest: TButton;
        edURL: TEdit;
        Label1: TLabel;
        procedure btnTestClick(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;var
      MainFrm: TMainFrm;implementation{$R *.dfm}
    procedure FillIEForm(aURL:string);
      procedure DoWithHtmlElement(aElementCollection:IHTMLElementCollection);
      var
        k:integer;
        vk:oleVariant;
        Dispatch: IDispatch;
        HTMLInputElement:IHTMLInputElement;
        HTMLSelectElement:IHTMLSelectElement;
        HTMLOptionElement: IHTMLOptionElement;
        HTMLTextAreaElement: IHTMLTextAreaElement;
        HTMLFormElement:IHTMLFormElement;
        HTMLOptionButtonElement:IHTMLOptionButtonElement;
      begin
        for k:=0 to aElementCollection.length -1 do
        begin
          Vk:=k;
          Application.ProcessMessages;
          Dispatch:=aElementCollection.item(Vk,0);
          if Succeeded(Dispatch.QueryInterface(IHTMLInputElement,HTMLInputElement)) then
          begin
            With HTMLInputElement do//单行文本
            begin
              if (UpperCase(Type_)='TEXT') or (UpperCase(Type_)='PASSWORD') then
              begin
                value:='text';
              end
              else if (UpperCase(Type_)='CHECKBOX') then//复选框
              begin
                checked:=true;
              end
              else if (UpperCase(Type_)='RADIO') then//单选框
              begin
                checked :=true;
              end;
            end;
          end
          else if Succeeded(Dispatch.QueryInterface(IHTMLSelectElement,HTMLSelectElement)) then
          begin
            With HTMLSelectElement do//下拉框
            begin
              selectedIndex :=1;
            end;
          end
          else if Succeeded(Dispatch.QueryInterface(IHTMLTEXTAreaElement,HTMLTextAreaElement)) then
          begin
            with HTMLTextAreaElement do//多行文本
            begin
              value :='textarea';
            end;
          end
          else if Succeeded(Dispatch.QueryInterface(IHTMLOptionElement,HTMLOptionElement)) then
          begin
            with HTMLOptionElement do//下拉选项
            begin
              //处理
            end;
          end
          else if SUCCEEDED(Dispatch.QueryInterface(IHTMLFormElement,HTMLFormElement))then
          begin
            with HTMLFormElement do//表单
            begin
              //处理
            end;
          end
          else if SUCCEEDED(Dispatch.QueryInterface(IHTMLOptionButtonElement,HTMLOptionButtonElement))then
          begin
            //不明
            //处理
          end
          else
            //showmessage('other');
            ;
        end;
      end;
    var
      ShellWindow: IShellWindows;
      Web: IWebBrowser2;
      Dispatch: IDispatch;
      i,j:integer;
      IEAddress:string;
      HTMLDocument:IHTMLDocument2;
      ElementCollection:IHTMLElementCollection;
      FrameWindow:IHTMLWindow2;
      Vi,Vj:OLEVariant;
      HTMLFrameBase :IHTMLFrameBase ;
      HTMLFrameElement:IHTMLFrameElement ;
      HTMLIFrameElement:IHTMLIFrameElement;
    begin
      ShellWindow := CoShellWindows.Create;
      for i:=0 to ShellWindow.Count -1 do
      begin
        Vi:=i;
        Dispatch:=ShellWindow.Item(Vi);
        if Dispatch=nil then continue;
        Dispatch.QueryInterface(IWebBrowser2,Web);
        if Web<>nil then
        begin
          IEAddress:=Web.LocationURL;
          if Pos(aURL,IEAddress)>0 then
          begin
            Web.Document.QueryInterface(IHTMLDocument2,HTMLDocument);
            if HTMLDocument<>nil then
            begin
              if HTMLDocument.frames.length =0 then//无框架
              begin
                ElementCollection:=HTMLDocument.Get_All;
                DoWithHtmlElement(ElementCollection);
              end
             else//有框架
              begin
                for j:=0 to HTMLDocument.frames.length -1 do
                begin
                  Vj:=j;
                  Dispatch:=HTMLDocument.frames.item(Vj);
    //              if Succeeded(Dispatch.QueryInterface(IHTMLFrameBase,HTMLFrameBase)
                  if Succeeded(Dispatch.QueryInterface(IHTMLWindow2,FrameWindow)) then
                  begin
    //                DoWithHtmlElement(FrameWindow.document.all);
                  end;
                End;
              end;
            end;
          end;
        End;
      end;
    end;procedure TMainFrm.btnTestClick(Sender: TObject);
    begin
      FillIEForm(edUrl.Text);
    end;
    end.
      

  3.   

    上面的是转来的,我以前用VB做很简单的,你看看哈Private Sub WebBrowser1_DocumentCompleted(ByVal sender As System.Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted if sendtime=1 then        sendtime=0  '发送次数归0,不然会发个没停的,除非你上面的form里面target是_blank就不用这个!加在这因为下面FORM会跳转,Sendtime如果加在他后面就不能改为别的值了。        WebBrowser1.Document.Write("<html>")
            WebBrowser1.Document.Write("<head>")
            WebBrowser1.Document.Write("<meta http-equiv=Content-Type content='text/html; charset=gb2312'>")
            WebBrowser1.Document.Write("<META http-equiv=Content-Language content=zh-cn>")
            WebBrowser1.Document.Write("</head>")
            WebBrowser1.Document.Write("<body>")
            WebBrowser1.Document.Write("<form target=_blank method=post action=" & "http://www.0796.com.cn/" & ">")
            WebBrowser1.Document.Write("<input type='hidden' value='" & Now() & "'>")
            WebBrowser1.Document.Write("<input type='hidden' value='" & Now.Day() & "'>")
            WebBrowser1.Document.Write("<input value='" & Now.Date() & "'>")
            WebBrowser1.Document.Write("<input value='" & Me.Text & "'>")
            WebBrowser1.Document.Write("<input value='login'>")
            WebBrowser1.Document.Write("</form>")
            WebBrowser1.Document.Write("<Script>login.submit();</Script>")
            WebBrowser1.Document.Write("</body>")
            WebBrowser1.Document.Write("</html>")        end if    End Sub下面的这种方法也不错,不过比前面的要麻烦,因为接收方服务端要多加一个页面。    Me.WebBrowser1.Document.All("cid").SetAttribute("value", "1111")    Me.WebBrowser1.Document.All("Action").SetAttribute("value", "Run")    Me.WebBrowser1.Document.Forms(0).InvokeMember("submit")以上这段代码是把webbrowser控件中已经打开的一个表单中的各项填写,再发送submit,当然submit可以不要,因为网页上边可以在最后一个文本框或者控件上添加一个onchange事件,也就是这样<input >,这样表单被自动填完后,网页自己会发出表单submit,主要原因是我前面发的vb2005代码里边的submit不太好用!
      

  4.   

    WB空间的方法很不爽。这两天我正好在研究百度。分析结果~~百度的登陆很好做~~但是发帖很麻烦~~登陆Url:http://passport.baidu.com/?login登陆参数:tpl_ok
    next_target
    tpl
    skip_ok
    aid
    need_pay
    need_coin
    pay_method
    u ./
    return_method get
    more_param
    return_type
    psp_tt 0
    username (用户名)
    password (密码)发帖Url:http://tieba.baidu.com/f发帖参数:这些都是用HttpWatch Studio截取分析的
    ct 385875968
    tn baiduSubmitThread
    word (贴吧关键字)
    lm 425748
    z 0
    sc 0
    cm 0
    bs BC75D665FC9700605CEF4C0565F82BC07E4DF11410258A93CE8A98C2A24B0E9D3EE7F4A7BB41AD714CAFE6C6489D5BC77FA80411395409111147854FEB6E29C26FC9977179  //最长的这个,就是百度的验证码地址,一会儿给出详细解释
    str2 (这里,在html里面有一个js的脚本函数,是10个数字用&、|、^不同的操作出来的一个数字,要自己算,会儿我把计算方法发上来)
    str3 7CAE24D1837E45A61E848B69F36F5EE7 
    str4 29500676872911163721  //这两个都是从网页里面用正则提取出来的
    bu http://tieba.baidu.com/f?ct=&tn=&rn=&pn=&lm=&sc=&kw=%C4%A7%B7%A8%CA%C0%BC%CD&rs2=0&myselectvalue=1&word=%C4%A7%B7%A8%CA%C0%BC%CD&tb=on  //这里可以设为空串,什么都可以,就是告诉百度贴子发完之后回到哪里
    ti 【测试】//标题
    co 测试~~仅仅是测试~~//内容
    str1 http://       这一个参数是后面跟的图像的地址
    ch1 on    //如果是登陆用户,这里就是ch1=on
                  //如果登陆用户的信用不高,就是脚本里有一个need_verify,如果等于10,就还得附上一个参数
                    //word1=(验证码)
                    //如果是匿名用户,ch1就不存在,换成rs1=1,并且一定要附上word1(匿名一定要验证码)
    Submit3 发表贴子 //这个不用管,就是按钮
      

  5.   

    http://tieba.baidu.com/cgi-bin/genimg?D5DA1632896C8562A74E026B58710D7DB4CACA7607C4819866CD98E0A64312C6CDF8E0A65FC057311B2C3B4692831F84E60C9039B14D4AC8941D55536FC4B0
    上面那个就是验证码的地址,用Idhttp的Get方法就可以把那个图片以流的方式下载回来了。。是一个Jpg图片参数的构造使用TStrings,但要用子类TStringList实例化
    参数如下加入:
    var
      T:TStrings;
      Response:TStringStream;
    begin
      T:=TStringList.Create;
      Response:=TStringStream.Create('');
      T.Add('参数名=内容');
      try
        IdHttp1.post(Url{这是提交地址,就是上面给出的地址},T{参数列表},Response{返回流});
      end;
    end;
      

  6.   

    Cookie的保存唉…………麻烦啊…………
    我很想上传一个类上来但是…………那是保密内容啊
      //设置登陆信息
      FIdhttp.Request.Referer:=LoginUrl;
      FIdhttp.Request.From:=HomeUrl;
      FIdhttp.HandleRedirects:=true;
      FIdhttp.RedirectMaximum:=1;
      //发生事件
      if Assigned(FOnLogin) then FOnLogin(Self);
      try
        Response:=FIdhttp.Post(LoginUrl,LoginForm.GetPars);
      except
        on E:Exception do
          MessageBox(0,PChar('登录时发生错误!错误信息:'+E.Message),PChar('登陆错误'),MB_OK or MB_ICONERROR);
      end;  for i := 0 to FIdHttp.Response.RawHeaders.Count - 1 do
      begin
        if UpperCase(Copy(FIdHttp.Response.RawHeaders[i],1,10)) = 'SET-COOKIE' then
        begin
          FCookie := Trim(Copy(FIdHttp.Response.RawHeaders[i],12,MaxInt));
          FCookie :=Copy(Cookie,1,Pos(';',Cookie));
          FCookieList := FCookieList + Cookie;
        end;
      end;
      FIdHttp.Request.RawHeaders.Add('Cookie:   '+FCookieList);
    上面的代码可以把Cookie保存在IdHttp里面
    还有,刚才说了str2参数是由如下的一个js脚本生成function fr_as_js_tr(){ return ((((((((((0x0fffffff&104)^109)|101)&107)|107)^108)^103)^108)^103)&104);}
    那么如何得到它的值呢?function TBaiduPost.GetStr2(html: string):string;
    const
      Str2Exp = 'return \(\(\(\(\(\(\(\(\(\(0x0fffffff(.*?);';
      OpSet = ['&','|','^'];
      CutSet = [')'];
    var
      Exp:TRegExpr;
      Expression:string;
      Number:Integer;
      SubS:String;
      Op,ch:Char;
      i: Integer;
    begin
      Result:='';
      Exp:=TRegExpr.Create;
      Exp.Expression:=Str2Exp;
      Number:=268435455;
      if Exp.Exec(html) then
      begin
        Expression:=Exp.Match[1];
        for i := 1 to Length(Expression) do
        begin
          ch:=Expression[i];
          if ch in OpSet then
            Op:=ch
          else if (ch in CutSet) then
          begin
            case op of
            '&':Number:=Number and StrToInt(SubS);
            '|':Number:=Number or StrToInt(SubS);
            '^':Number:=Number xor StrToInt(SubS);
            end;
            Subs:='';
          end
          else SubS:=SubS + Ch;           
        end;
        Result:=IntToStr(Number);
      end;
      Exp.Free;
    end;其中TRegExpr是网上通用的一个正则表达式的类,可以找到相关资料看一下
      

  7.   

    不好意思,发贴的时候没看清你说的。
    其实你用VB很容易实现的,我以前做过。
    只要获取webbrowser里面的内容,检查一下是否含有[指定关键字(比如页面标题)],在web DocumentComplete事件每次发生时,根据不同的关键去判断目前是在哪个页面,要转到哪个页面,要发送什么,上面的代码你可以自己试着改改。
    实现起来不会很难的,百度的没有验证码,所以很容易做。