首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

打开网页并自动输入用户名和密码自动登录的一个有关问题

2013-04-20 
打开网页并自动输入用户名和密码自动登录的一个问题本帖最后由 bcrun 于 2013-04-04 19:07:06 编辑下面是

打开网页并自动输入用户名和密码自动登录的一个问题
本帖最后由 bcrun 于 2013-04-04 19:07:06 编辑 下面是模块中的代码,登录的地址是单位内部的一个网页

Public Const JiLiangGuanLiXiTong = "http://10.67.132.33/"

Function OpenJiLiangXiTong(name As String, mima As String) As String  '自动登录子程序
    
    Dim vDoc, vTag
    Dim i As Integer
    
    Dim browser As Object, timeie As Date
    
    Set browser = CreateObject("InternetExplorer.application")
    browser.Visible = True
    browser.Navigate (JiLiangGuanLiXiTong)    
    
    timeie = DateAdd("s", 60, Now()) '等待60s
    Do While browser.Busy And Not browser.ReadyState = False
        DoEvents   
        If timeie < Now() Then
            MsgBox "网络不通!", vbInformation, "网络不通"
            browser.Quit
            Exit Function
        End If
    Loop
       
    Set vDoc = browser.Document
    For i = 0 To vDoc.All.Length - 1
        If UCase(vDoc.All(i).tagName) = "INPUT" Then
            Set vTag = vDoc.All(i)
            If vTag.Type = "text" Or vTag.Type = "password" Then
                Select Case vTag.name
                    Case "Username"
                        vTag.Value = name
                    Case "Password"
                        vTag.Value = mima
                End Select
            ElseIf vTag.Type = "image" Then
                vTag.Select
                vTag.Click
            End If
        End If
    Next i
    
End Function


大多情况下程序没有问题,低概率会出现如下问题,尤其出现在连续登陆的时候。
1.不自动登陆,网页上填写用户名和密码的地方空白;(此时程序没有任何其他反应)
2.提示:运行时错误‘70’:拒绝的权限;(此时登陆成功,但程序崩溃了)



除了上面两个问题外,还出现过一次其他问题,不过只出现过一次,提示内容没有记下来,不过同样是登陆成功,但程序崩溃了。

[解决办法]
browser要等待网页加载完毕,还要考虑到框架及脚本,为什么不用xmlhttp模拟post包发送,下面是登陆代码,sendstr要通过抓包获得

Dim xPost, sGet As Object
        Dim iRemote,  sendstr, tempAs String
        Dim k As Integer
        Set xPost = CreateObject("Microsoft.XMLHTTP")
       Set sGet = CreateObject("ADODB.Stream")
  iRemote = "http://10.67.132.33/"
  sendstr = "Username=" & name & "Password=" & mima
   xPost.Open "post", iRemote, False
    xPost.setRequestHeader "Accept", "image/gif, image/jpeg, image/pjpeg, image/pjpeg, application/x-shockwave-flash, application/xaml+xml, application/x-ms-xbap, application/x-ms-application, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*"
        xPost.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        xPost.setRequestHeader "Accept-Language", "zh-cn"
        xPost.setRequestHeader "Accept-Encoding", "gzip, deflate"
        xPost.setRequestHeader "Referer", "http://10.67.132.33/"
        xPost.send (sendstr)
       If xPost.readyState = 4 Then
         If xPost.Status = 200 Then
           sGet.mode = 3
        sGet.Type = 1
        sGet.Open
        sGet.Write (xPost.responseBody)
        sGet.Position = 0
        sGet.Type = 2
        sGet.charset = "gb2312" ' "gb2312"
        temp = sGet.ReadText '返回的网页
end if
end if

热点排行