’WebBrowser控件的控制
'原创xiaowenhome@21cn.com
'语言:vb 2005
'调用前,请先调用“提取所有元素”,作用是提取指定网页的所有HtmlElement
'使用时请保留以上信息,多谢
Public Class ClassWebBrowser控制
Public theID As Int32
Public HElist As New ArrayList
Function 填写表单(ByVal name As String, ByVal value As String, ByVal htmlDoc As HtmlDocument) As Boolean
If htmlDoc Is Nothing Then
Return False
End If
Dim username As HtmlElement = htmlDoc.All(name)
If username Is Nothing Then
Return False
Else
username.SetAttribute("value", value)
Return True
End If
End Function
Function 填写表单(ByVal name As String, ByVal value As String) As Boolean
Dim username As HtmlElement = Me.按name查找(name)
If username Is Nothing Then
Return False
Else
username.SetAttribute("value", value)
Return True
End If
End Function
Function 填写表单(ByVal 元素ID As Int32, ByVal value As String) As Boolean
Dim username As HtmlElement = Me.HElist(元素ID)
If username Is Nothing Then
Return False
Else
username.SetAttribute("value", value)
Return True
End If
End Function
Sub 提取图片(ByVal htmlDoc As HtmlDocument)
'Dim ctrlRange = htmlDoc.Body.createControlRange()
'htmlDoc.Images.Item(0)
End Sub
Sub 设置焦点(ByVal name As String, ByVal htmlDoc As HtmlDocument)
If htmlDoc Is Nothing Then
Exit Sub
End If
Dim username As HtmlElement = htmlDoc.All(name)
If username Is Nothing Then
Else
username.Focus()
End If
End Sub
Function 点击按扭(ByVal name As String, ByVal htmlDoc As HtmlDocument) As Boolean
If htmlDoc Is Nothing Then
Return False
End If
Dim username As HtmlElement = htmlDoc.All(name)
username.InvokeMember("Click")
Return True
End Function
Function 点击按扭(ByVal wID As Int32) As Boolean
Try
Dim username As HtmlElement = Me.HElist(wID)
username.InvokeMember("Click")
Return True
Catch ex As Exception
System.Console.WriteLine(ex.ToString)
Return False
End Try
End Function
Function 向下键(ByVal wID As Int32) As Boolean
Try
Dim username As HtmlElement = Me.HElist(wID)
username.InvokeMember("KeyDown")
Return True
Catch ex As Exception
System.Console.WriteLine(ex.ToString)
Return False
End Try
End Function
Function 点击按扭(ByVal name As String) As Boolean
Dim username As HtmlElement = Me.按name查找(name)
If username Is Nothing Then
Return False
End If
username.InvokeMember("Click")
Return True
End Function
Function 点击按扭(ByVal ID As Int32, ByVal htmlDoc As HtmlDocument) As Boolean
If htmlDoc Is Nothing Then
Return False
End If
Dim username As HtmlElement = htmlDoc.All(ID)
username.InvokeMember("Click")
Return True
End Function
Function 运行Script函数(ByVal 函数名 As String, ByVal 参数() As Object, ByVal htmlDoc As HtmlDocument) As Object
'Dim args(0) As Object
'args(0) = 4011
Dim s As Object = htmlDoc.InvokeScript(函数名, 参数)
Return s
End Function
Sub 测试表单名称(ByVal htmlDoc As HtmlDocument)
Dim i As Int16
Dim j As Int16
Dim c As Int32
For j = 0 To htmlDoc.Window.Frames.Count - 1
For i = 0 To htmlDoc.Window.Frames(j).Document.All.Count - 1
Dim username As HtmlElement = htmlDoc.Window.Frames(j).Document.All(i)
If username Is Nothing Then
Else
c = c + 1
username.SetAttribute("value", j & "-" & i)
End If
If c = 95 Then
Dim a As String = 1
End If
Next
Next
End Sub
Function 提取所有元素(ByVal htmlDoc As HtmlDocument) As Boolean
Try
theID = 0
Me.HElist = New ArrayList
递归元素(htmlDoc)
Return True
Catch ex As Exception
System.Console.WriteLine(ex.ToString)
Return False
End Try
End Function
Sub 递归元素(ByVal htmlDoc As HtmlDocument)
'Dim ref(0) As Object
'Dim t As Boolean = False
'ref(0) = t
'Dim s As Object = 运行Script函数("OutputDataLoading", ref, htmlDoc)
'If s Is Nothing Then
'Else
'Dim a As String = 1
'End If
Dim i As Int32
For i = 0 To htmlDoc.All.Count - 1
Dim username As HtmlElement = htmlDoc.All(i)
If username Is Nothing Then
HElist.Add(username)
'username.SetAttribute("value", HElist.Count - 1)
End If
If theID = 486 Then
Dim a As String = 1
'username.InnerHtml = "<DIV>QQQQQQQQQQQQQQQQQQQQQQiiiiiiiiii </DIV><QZONE>"
End If
If theID = 123 Then
'username.SetAttribute("value", "770888873@qq.com")
End If
If theID = 150 Then
'username.SetAttribute("value", "770fsadfas")
End If
If theID = 367 Then
'username.InvokeMember("Click")
End If
Next
Dim j As Int16
If htmlDoc.Window.Frames.Count = 0 Then
Exit Sub
End If
For j = 0 To htmlDoc.Window.Frames.Count - 1
递归元素(htmlDoc.Window.Frames(j).Document)
Next
End Sub
Sub 元素亮(ByVal HE As HtmlElement)
HE.Style = "background-color: #FFFF00"
End Sub
Sub 标识所有元素()
Dim i As Int32
For i = 0 To Me.HElist.Count - 1
Dim username As HtmlElement = HElist(i)
If username Is Nothing Then
Else
Try
'username.SetAttribute("value", i)
username.SetAttribute("value", i & username.Name)
Catch ex As Exception
System.Console.WriteLine(ex)
End Try
End If
Next
End Sub
Function 按name查找(ByVal w As String) As HtmlElement
Dim i As Int32
For i = 0 To Me.HElist.Count - 1
Dim username As HtmlElement = HElist(i)
If username Is Nothing Then
Else
Try
Dim tem As String = username.Name
If Not (tem Is Nothing) Then
If tem = w Then
Return username
End If
End If
Catch ex As Exception
System.Console.WriteLine(ex)
End Try
End If
Next
Return Nothing
End Function
Function 按InnerHtml查找_等于(ByVal w As String) As HtmlElement
Dim i As Int32
For i = 0 To Me.HElist.Count - 1
Dim username As HtmlElement = HElist(i)
If username Is Nothing Then
Else
Try
Dim tem As String = username.InnerHtml
If Not (tem Is Nothing) Then
If tem.Length >= w.Length Then
If tem = w Then
Return username
End If
End If
End If
Catch ex As Exception
System.Console.WriteLine(ex)
End Try
End If
Next
Return Nothing
End Function
Function 查找指定包含文字(ByVal w As String) As Boolean
Dim i As Int32
For i = 0 To Me.HElist.Count - 1
Dim username As HtmlElement = HElist(i)
If username Is Nothing Then
Else
Try
Dim tem As String = username.InnerText
If Not (tem Is Nothing) Then
If tem.Length > 20 Then
If InStr(tem, w) > 0 Then
Return True
End If
End If
End If
Catch ex As Exception
System.Console.WriteLine(ex)
End Try
End If
Next
Return False
End Function
End Class