Login to a website using VB6

Question

I want to login to a website using visual basic 6 this is my code:

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

I get this error when Text1_Change event occurs :

"Error 91 : object variable or with block variable not set"

Please help me to solve this problem.

Answer 1

You must write the correct element name or Id. If you know the name or id and type you can try this:

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

You can also use WebBrowser1.Document.Forms(0)(i).Type = "password" instead "text" and WebBrowser1.Document.Forms(0)(i).Id instead "name"

If the name or Id are generated dynamically, you shouldn't find element by id or name. simply use the type.

Answer 2

This code works properly. Don't remove "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

Answer 3

LibCurl is needed for the following to work: http://curl.haxx.se/gknw.net/7.29.0/dist-w32/curl-7.29.0-devel-mingw32.zip

As well as the vb6 bindings for libCurl: http://sourceforge.net/projects/libcurl-vb/

Main function:

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

Place in .bas file:

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

Place in 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