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

[luzhipeng81]

下面是模块中的代码，登录的地址是单位内部的一个网页

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’：拒绝的权限；（此时登陆成功，但程序崩溃了）

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

[luzhipeng81]

多谢高手帮忙解决！

[shinni987654]

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