VB6中采用WebBrowser自动填写并提交表单参考源码，已经可以实现自动填写并提交。对代码优化可以达到更好的效果。
Public Sub WebbFormEditing()
Dim i, j As Integer
Dim vForm, vSubmit
Dim vFrame
On Error Resume Next
Set vFrame = WebBrowser1.Document.frames
If IsEmpty(vFrame) Then GoTo ErrorFormEdit
For i = 0 To vFrame.length - 1
On Error Resume Next
vFrame(i).Document.body.innerHTML = tbHtml.Text
Next i
ErrorFormEdit:
On Error GoTo ErrorFormEditEnd
Set vForm = WebBrowser1.Document.Forms
If IsEmpty(vForm) Then GoTo ErrorFormEditEnd
Me.CurWebbState = 3 '填表单
For i = 0 To vForm.length - 1
On Error GoTo ErrorFormEditEnd
If InStr(1, vForm(i).name, "login", vbTextCompare) > 0 Then '登录
ElseIf InStr(1, vForm(i).name, "search", vbTextCompare) > 0 Or _
InStr(1, vForm(i).name, "find", vbTextCompare) > 0 Then '搜索
Else '其他表单,先填了
On Error Resume Next
vForm(i).onSubmit = ""
For j = 0 To vForm(i).length - 1
If UCase(vForm(i)(j).tagName) = "INPUT" Then 'INPUT
Select Case LCase(vForm(i)(j).Type)
'********************text*********************
Case "text":
'1,链接
If InStr(1, vForm(i)(j).name, "url", vbTextCompare) > 0 Or InStr(1, vForm(i)(j).name, "link", vbTextCompare) > 0 Or _
InStr(1, vForm(i)(j).name, "home", vbTextCompare) > 0 Or InStr(1, vForm(i)(j).name, "address", vbTextCompare) > 0 Or _
InStr(1, vForm(i)(j).name, "tags", vbTextCompare) > 0 Then
vForm(i)(j).Value = tbLink.Text
'EMail
ElseIf InStr(1, vForm(i)(j).name, "email", vbTextCompare) > 0 Then
vForm(i)(j).Value = tbEmail.Text
'名称
ElseIf InStr(1, vForm(i)(j).name, "name", vbTextCompare) > 0 Or InStr(1, vForm(i)(j).name, "user", vbTextCompare) > 0 Or _
InStr(1, vForm(i)(j).name, "author", vbTextCompare) > 0 Then
vForm(i)(j).Value = tbName.Text
'标题
ElseIf InStr(1, vForm(i)(j).name, "title", vbTextCompare) > 0 Or InStr(1, vForm(i)(j).name, "topic", vbTextCompare) > 0 Then
If Len(vForm(i)(j).Value) <= 0 Then vForm(i)(j).Value = tbTitle.Text
'评论,摘要
ElseIf InStr(1, vForm(i)(j).name, "summary", vbTextCompare) > 0 Or InStr(1, vForm(i)(j).name, "comment", vbTextCompare) > 0 Or _
InStr(1, vForm(i)(j).name, "content", vbTextCompare) > 0 Then
vForm(i)(j).Value = tbTextArea.Text
'QQ
ElseIf InStr(1, vForm(i)(j).name, "qq", vbTextCompare) > 0 Or InStr(1, vForm(i)(j).name, "icq", vbTextCompare) > 0 Then
vForm(i)(j).Value = tbQQ.Text
'验证码
ElseIf InStr(1, vForm(i)(j).name, "Random", vbTextCompare) > 0 Then
Beep
End If
'****************text***************
Case "password"
Case "submit"
Set vSubmit = vForm(i)(j)
End Select
ElseIf UCase(vForm(i)(j).tagName) = "SELECT" Then
ElseIf UCase(vForm(i)(j).tagName) = "TEXTAREA" Then
vForm(i)(j).innerHTML = tbTextArea.Text
End If
Next j
' 当前表单填完,提交
If Not IsEmpty(vSubmit) Then
On Error GoTo ErrorFormEditEnd
Me.LbState.Caption = "提交"
Me.CurWebbState = 4
vSubmit.Click
End If
End If
Next i
If Me.CurWebbState <> 4 Then Me.CurWebbState = 5 '没有可提交的表单
Exit Sub '结束过程
'出错退出
ErrorFormEditEnd:
Me.CurWebbState = 11
End Sub
