|
IEのクリック操作を保存し再生するサンプル(VB.NET)
|
WEBページのクリック操作を保存し再生するサンプルです。
WEBページの開発時に毎回行なう操作の自動化に使えると思いますが。。。
このサンプルでクリック操作を保存し再生する対象はリンクとボタンです。
また、マウスクリックのみ保存しています。ＥＮＴＥＲキーは未対応です。
WEBページの操作(フォーム入力、リンクやボタン等のクリック)を記録し再生する
ツールはこちらです。ＷＥＢ操作再生ツール(WebRecPlay)はＷＥＢページの入力
操作やクリック操作を記録し再生するツールです。コマ送り再生やショートカット
からの再生が出来ます。このサンプルとはちょっと違う方法でＷＥＢページの記録
再生を実現しています。
★フォームモジュール(Form1.vb)
Public Class Form1
' クリック操作を保存するコレクション
Private clClkElm As Collection = New Collection
' リンクのクリックイベント
Private IeAncEvt As IeAncEvent() = New IeAncEvent(99) {}
Public Class IeAncEvent
Public WithEvents Evt As mshtml.HTMLAnchorEvents2_Event = Nothing
End Class
' ボタンのクリックイベント
Private IeInpEvt As IeBtnEvent() = New IeBtnEvent(99) {}
Public Class IeBtnEvent
Public WithEvents Evt As mshtml.HTMLInputTextElementEvents2_Event = Nothing
End Class
' クリック操作保存ボタンの処理
Private Sub BtnRec_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnRec.Click
GetIeObj()
Dim elms As Object
Dim fras As Object
' リンクのクリックイベント設定
elms = CType(ObjIeDoc, mshtml.IHTMLDocument3).getElementsByTagName("a")
For el As Integer = 0 To elms.length - 1
IeAncEvt(el) = New IeAncEvent
IeAncEvt(el).Evt = elms(el)
AddHandler IeAncEvt(el).Evt.onclick, AddressOf ElmOnClick
Next
' リンクのクリックイベント設定(フレーム対応)
fras = CType(ObjIeDoc, mshtml.IHTMLDocument2).frames
For i As Integer = 0 To fras.length - 1
elms = CType(fras(i).document, mshtml.IHTMLDocument3).getElementsByTagName("a")
For el As Integer = 0 To elms.length - 1
IeAncEvt(el) = New IeAncEvent
IeAncEvt(el).Evt = elms(el)
AddHandler IeAncEvt(el).Evt.onclick, AddressOf ElmOnClick
Next
Next
' ボタンのクリックイベント設定
elms = CType(ObjIeDoc, mshtml.IHTMLDocument3).getElementsByTagName("input")
For el As Integer = 0 To elms.length - 1
Dim strTyp As String = ""
If elms(el).type Is Nothing = False Then strTyp = elms(el).type
If strTyp.ToLower = "button" Or strTyp.ToLower = "submit" Then
IeInpEvt(el) = New IeBtnEvent
IeInpEvt(el).Evt = elms(el)
AddHandler IeInpEvt(el).Evt.onclick, AddressOf ElmOnClick
End If
Next
' ボタンのクリックイベント設定(フレーム対応)
fras = CType(ObjIeDoc, mshtml.IHTMLDocument2).frames
For i As Integer = 0 To fras.length - 1
elms = CType(fras(i).document, mshtml.IHTMLDocument3).getElementsByTagName("input")
For el As Integer = 0 To elms.length - 1
Dim strTyp As String = ""
If elms(el).type Is Nothing = False Then strTyp = elms(el).type
If strTyp.ToLower = "button" Or strTyp.ToLower = "submit" Then
IeInpEvt(el) = New IeBtnEvent
IeInpEvt(el).Evt = elms(el)
AddHandler IeInpEvt(el).Evt.onclick, AddressOf ElmOnClick
End If
Next
Next
End Sub
' クリック操作再生ボタンの処理
Private Sub BtnPlay_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnPlay.Click
For i As Integer = 1 To clClkElm.Count
For el As Integer = 0 To ObjIeDoc.all.length - 1
If ObjIeDoc.all(el).outerHTML = clClkElm(i) Then
ObjIeDoc.all(el).click()
End If
Next
Next
End Sub
' リンクのクリックイベントをコレクションに保存
Private Function ElmOnClick(ByVal pEvtObj As mshtml.IHTMLEventObj) As Boolean
Debug.Print("1:" & pEvtObj.srcElement.outerHTML)
clClkElm.Add(pEvtObj.srcElement.outerHTML)
Return True
End Function
End Class
★標準モジュール(Form1.vb)
Imports System.Runtime.InteropServices
Module Module1
' APIの定義
Private Const SMTO_ABORTIFHUNG = &H2
Private Delegate Function D_EnumChildWindowsProc(ByVal hWnd As Integer, ByVal lParam As Integer) As Integer
Private Declare Function EnumChildWindows Lib "user32.dll" (ByVal hwndParent As Integer, ByVal lpEnumFunc As D_EnumChildWindowsProc, ByVal lParam As Integer) As Integer
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hWnd As Integer, ByVal lpClassName As Byte(), ByVal nMaxCount As Integer) As Integer
Private Declare Function RegisterWindowMessage Lib "user32.dll" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Integer
Private Declare Function ObjectFromLresult Lib "oleacc.dll" Alias "ObjectFromLresult" (ByVal lResult As Int32, ByRef riid As System.Guid, ByVal wParam As Int32, <MarshalAs(UnmanagedType.Interface)> ByRef ppvObject As Object) As Integer
Private Declare Function SendMessageTimeout Lib "user32.dll" Alias "SendMessageTimeoutA" (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer, ByVal fuFlags As Integer, ByVal uTimeout As Integer, ByRef lpdwResult As Integer) As Integer
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As Integer, ByVal hwndChildAfter As Integer, ByVal lpszClass As String, ByVal lpszWindow As String) As Integer
Public ObjIeDoc As mshtml.IHTMLDocument = Nothing
' 最前面のＩＥのＷＥＢページ(mshtml.IHTMLDocument)取得
Public Sub GetIeObj()
' 最前面のＩＥ取得
Dim hwnd As Integer = FindWindowEx(0, 0, "IEFrame", vbNullString)
' ＩＥに表示されているＷＥＢページ(mshtml.IHTMLDocument)取得
EnumChildWindows(hwnd, AddressOf EnumChildWindowsProc, 0)
End Sub
' ＩＥに表示されているＷＥＢページ(mshtml.IHTMLDocument)取得
Private Function EnumChildWindowsProc(ByVal hWnd As Integer, ByVal lParam As Integer) As Integer
' クラス名取得
Dim bytClass As Byte() = New Byte(255) {}
Dim strClass As String = ""
GetClassName(hWnd, bytClass, 255)
strClass = StripNulls(bytClass)
' ＩＥクラス名チェック
If strClass.ToLower = "internet explorer_server" Then
' ＷＥＢページ(mshtml.IHTMLDocument)取得
Dim intR As Integer
Dim intM As Integer = RegisterWindowMessage("WM_HTML_GETOBJECT")
SendMessageTimeout(hWnd, intM, 0, 0, SMTO_ABORTIFHUNG, 1000, intR)
If intR <> 0 Then
Dim IID_IHTMLDocument As System.Guid = New System.Guid("626FC520-A41E-11CF-A731-00A0C9082637")
ObjectFromLresult(intR, IID_IHTMLDocument, 0, ObjIeDoc)
End If
Return 0
End If
Return 1
End Function
' 文字列からＮＵＬＬ文字以降をカット
Private Function StripNulls(ByVal bytOrg As Byte()) As String
Dim strOrg As String = System.Text.Encoding.GetEncoding("SHIFT-JIS").GetString(bytOrg)
Dim pt As Integer = strOrg.IndexOf(Chr(0))
If pt >= 0 Then strOrg = strOrg.Substring(0, pt)
Return strOrg
End Function
End Module