1

我想使用 Visual Basic 6 登录网站，这是我的代码：

Private Sub Command1_Click()
WebBrowser1.Document.All("btnSubmit").Click
End Sub

Private Sub Form_Load()
WebBrowser1.Navigate "https://golestan.farzanegan.ac.ir/Forms/AuthenticateUser/main.htm"
End Sub

Private Sub Text1_Change()
WebBrowser1.Document.All("F80351").Value = Text1.Text
'WebBrowser1.Document.getElementById("F80351").innertext = Text1.Text 'also this code dosen't work
End Sub

发生 Text1_Change 事件时出现此错误：

“错误 91：对象变量或未设置块变量”

请帮我解决这个问题。

4

3 回答 3

1

您必须编写正确的元素名称或 ID。如果您知道名称或 ID 和类型，您可以试试这个：

Private Sub Text1_Change()
  On Error Resume Next
  For i = 0 To WebBrowser1.Document.Forms(0).length - 1
     If WebBrowser1.Document.Forms(0)(i).Type = "text" and WebBrowser1.Document.Forms(0)(i).Name = "F80351" Then
        WebBrowser1.Document.Forms(0)(i).Value = Text1.text
     End If
  Next i
End Sub

您也可以使用 WebBrowser1.Document.Forms(0)(i).Type = "password" 代替 "text" 和 WebBrowser1.Document.Forms(0)(i).Id 代替 "name"

如果名称或 ID 是动态生成的，则不应按 id 或名称查找元素。只需使用类型。

于 2013-02-15T13:39:21.390 回答
0

以下工作需要 LibCurl：http ://curl.haxx.se/gknw.net/7.29.0/dist-w32/curl-7.29.0-devel-mingw32.zip

以及 libCurl 的 vb6 绑定：http: //sourceforge.net/projects/libcurl-vb/

主功能： 

Public Sub Login()

Dim buf As New StringBuffer
        CurlContext = vbcurl_easy_init()
        vbcurl_easy_setopt CurlContext, CURLOPT_URL, "https://www.website.com/login-verify-user.wml"
        vbcurl_easy_setopt CurlContext, CURLOPT_COOKIEJAR, App.Path & "\cookie.txt"
        vbcurl_easy_setopt CurlContext, CURLOPT_COOKIEFILE, App.Path & "\cookie.txt"
        vbcurl_easy_setopt CurlContext, CURLOPT_FOLLOWLOCATION, 1

        vbcurl_easy_setopt CurlContext, CURLOPT_POST, 1
        vbcurl_easy_setopt CurlContext, CURLOPT_POSTFIELDS, "UserName=" & URLencode(uID) & "&Password=" & URLencode(PWD) & "&Login=Login&Login="

        'This section sets proxy settings, etc. and so is optional.
        vbcurl_easy_setopt CurlContext, CURLOPT_TIMEOUT, 15
        vbcurl_easy_setopt CurlContext, CURLOPT_PROXYAUTH, CURLAUTH_ANY
        vbcurl_easy_setopt CurlContext, CURLOPT_HTTPPROXYTUNNEL, 1
        vbcurl_easy_setopt CurlContext, CURLOPT_PROXY, proxyServer
        vbcurl_easy_setopt CurlContext, CURLOPT_PROXYPORT, 80
        vbcurl_easy_setopt CurlContext, CURLOPT_PROXYUSERPWD, ""
        vbcurl_easy_setopt CurlContext, CURLOPT_CAINFO, CertFile
        vbcurl_easy_setopt CurlContext, CURLOPT_SSLCERT, CertFile


        vbcurl_easy_setopt CurlContext, CURLOPT_WRITEDATA, ObjPtr(buf)
        vbcurl_easy_setopt CurlContext, CURLOPT_WRITEFUNCTION, _
            AddressOf WriteFunction
        vbcurl_easy_setopt CurlContext, CURLOPT_PROGRESSFUNCTION, _
            AddressOf ProgressCallback
        vbcurl_easy_setopt CurlContext, CURLOPT_NOPROGRESS, 0
        vbcurl_easy_setopt CurlContext, CURLOPT_DEBUGFUNCTION, _
            AddressOf DebugFunction
        vbcurl_easy_setopt CurlContext, CURLOPT_VERBOSE, True



        ret = vbcurl_easy_perform(CurlContext)

End Sub

放置在 .bas 文件中：

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function URLencode(ByRef TEXT As String) As String
    Const Hex = "0123456789ABCDEF"
    Dim lngA As Long, lngChar As Long
    URLencode = TEXT
    For lngA = LenB(URLencode) - 1 To 1 Step -2
        lngChar = Asc(MidB$(URLencode, lngA, 2))
        Select Case lngChar
            Case 48 To 57, 65 To 90, 97 To 122
            Case 32
                MidB$(URLencode, lngA, 2) = "+"
            Case Else
                URLencode = LeftB$(URLencode, lngA - 1) & "%" & Mid$(Hex, (lngChar And &HF0) \ &H10 + 1, 1) & Mid$(Hex, (lngChar And &HF&) + 1, 1) & MidB$(URLencode, lngA + 2)
        End Select
    Next lngA
End Function

Public Function ProgressCallback(ByVal notUsed As Long, _
    ByVal totaltodownload As Double, ByVal nowdownloaded As Double, _
    ByVal totaltoupload As Double, ByVal nowuploaded As Double) As Long

    'Paint and move form to avoid lock up
    DoEvents

    ProgressCallback = 0

End Function

' This function illustrates a couple of key concepts in libcurl.vb.
' First, the data passed in rawBytes is an actual memory address
' from libcurl. Hence, the data is read using the MemByte() function
' found in the VBVM6Lib.tlb type library. Second, the extra parameter
' is passed as a raw long (via ObjPtr(buf)) in Sub EasyGet()), and
' we use the AsObject() function in VBVM6Lib.tlb to get back at it.
Public Function WriteFunction(ByVal rawBytes As Long, _
    ByVal sz As Long, ByVal nmemb As Long, _
    ByVal extra As Long) As Long

    Dim totalBytes As Long, i As Long
    Dim obj As Object, buf As StringBuffer
    Dim tempStr As String
    Dim Buffer() As Byte

    totalBytes = sz * nmemb

    Set obj = AsObject(extra)
    Set buf = obj



    If Not ((rawBytes = 0) Or (totalBytes = 0)) Then

        ReDim Buffer(0 To (totalBytes - 1)) As Byte
        CopyMemory Buffer(0), ByVal rawBytes, totalBytes

        tempStr = String(totalBytes, " ")
        CopyMemory ByVal tempStr, Buffer(0), totalBytes

        buf.quickConcat (tempStr)

    End If
    'Debug.Print buf.stringData

    ' Need this line below since AsObject gets a stolen reference
    ObjectPtr(obj) = 0&


    ' Return value
    WriteFunction = totalBytes
End Function

' Again, rawBytes comes straight from libcurl and extra is a
' long, though we're not using it here.
Public Function DebugFunction(ByVal info As curl_infotype, _
    ByVal rawBytes As Long, ByVal numBytes As Long, _
    ByVal extra As Long) As Long

    Dim debugMsg As String
    Dim i As Long
    debugMsg = ""
    For i = 0 To numBytes - 1
        debugMsg = debugMsg & Chr(MemByte(rawBytes + i))
    Next
    Debug.Print "info=" & info & ", debugMsg=" & debugMsg
    DebugFunction = 0


End Function

放在 StringBuffer.cls 中：

Private byteData() As Byte
Private stringLength As Long
Private arrayLength As Long


Private Sub Class_Initialize()

ReDim byteData(1024)
arrayLength = 1024
stringLength = 0

End Sub



Public Property Get stringData() As String

stringData = String(stringLength, " ")
CopyMemory ByVal stringData, byteData(0), stringLength

End Property

Public Property Let stringData(newStringdata As String)

Dim newStringLength As Long

newStringLength = Len(newStringdata)

If newStringLength > arrayLength Then
    arrayLength = (arrayLength + (newStringLength - newStringLength Mod 2)) * 2
    ReDim Preserve byteData(arrayLength)
End If


CopyMemory byteData(0), ByVal newStringdata, newStringLength

stringLength = newStringLength


End Property

Public Function quickConcat(newStringdata As String)

Dim newStringLength As Long

newStringLength = Len(newStringdata) + stringLength

If newStringLength > arrayLength Then
    arrayLength = (arrayLength + (newStringLength - newStringLength Mod 2)) * 2
    ReDim Preserve byteData(arrayLength)
End If

Dim amountToAdd
amountToAdd = newStringLength - stringLength

CopyMemory byteData(stringLength), ByVal newStringdata, amountToAdd

stringLength = newStringLength

End Function
于 2013-02-19T15:16:47.140 回答
0

此代码正常工作。 不要删除“on error resume next” 

Private Sub Command1_Click()
    For i = 0 To WebBrowser1.Document.Forms(0).length - 1
      On Error Resume Next
      If WebBrowser1.Document.Forms(0)(i).Type = "submit" Then
          WebBrowser1.Document.Forms(0)(i).Click
      End If
    Next i
End Sub
于 2013-02-15T13:09:06.770 回答