7,759
社区成员
发帖
与我相关
我的任务
分享
Option Explicit
Private Sub Command3_Click()
Call SubmitWebForm(WebBrowser1, "spBCmtAuthor", "spBCmtURL", "spBCmtText", "username", "password", "Content111111111111111111111111111111111111111111111111111", "comment_post_form")
End Sub
'Junki Beta2(2007-12-4):填写表单的用户名、密码等信息,然后提交表单,模拟实现用户登录
Private Function SubmitWebForm(ByVal oOpenUrl As Object, ByVal sTagUserName As String, ByVal sTagEmail As String, ByVal sTagContent As String, ByVal sTxtUserName As String, ByVal sTxtPassWord As String, ByVal sTxtContent As String, ByVal sTagFormName As String) As Boolean
Dim webDoc As Object
Set webDoc = oOpenUrl.Document.All
Dim webTag As Object
Dim lengthTag As Integer
lengthTag = webDoc.Length - 1
On Error GoTo ErrMsg
'第一种方法,定位元素,然后设置其属性
Dim docHtml As MSHTMLCtl.HTMLDocument
Dim ElementForm As MSHTMLCtl.HTMLFormElement, Element As MSHTMLCtl.IHTMLElement
Set docHtml = oOpenUrl.Document
Set Element = docHtml.getElementById(sTagUserName)
If Not Element Is Nothing Then
Call Element.setAttribute("value", sTxtUserName)
Else
Exit Function
End If
Set Element = docHtml.getElementById(sTagEmail)
If Not Element Is Nothing Then
Call Element.setAttribute("value", sTxtPassWord)
Else
Exit Function
End If
Set Element = docHtml.getElementById(sTagContent)
If Not Element Is Nothing Then
Call Element.setAttribute("value", sTxtContent)
Else
Exit Function
End If
Set ElementForm = docHtml.getElementById(sTagFormName)
If Not ElementForm Is Nothing Then
Call ElementForm.submit
End If
Exit Function
ErrMsg:
MsgBox (Err.Message)
End Function
Private Sub Command1_Click()
Call WebBrowser1.Navigate2("http://my.chinahr.com/NewAccount.aspx?clickbutton=1&jtr=41518621&prj=fa")
End Sub