1

Visual Basic 6 を使用して Web サイトにログインしたいのですが、これは私のコードです。

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

このコードは正しく動作します。 「次のエラー再開時」を削除しないでください 

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 に答える
0

以下を機能させるには、LibCurl が必要です。

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 に答える