使用VB6登录到网站

我想使用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\u更改事件发生时，我收到此错误：

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

请帮我解决这个问题

此代码工作正常。 不删除“出错时继续下一步”

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

此代码工作正常。 不删除“出错时继续下一步”

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

---

必须写入正确的元素名称或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或名称查找元素。只需使用类型。

您必须写入正确的元素名称或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或名称查找元素。只需使用该类型。

LibCurl是以下各项工作所必需的：

以及libCurl的vb6绑定：

主要功能：

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

---

需要LibCurl才能执行以下操作：

以及libCurl的vb6绑定：

主要功能：

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