NonSoft

IEのクリック操作を保存し再生するサンプル(VB.NET)


 サンプル(ソース/コード)
WEBページのクリック操作を保存し再生するサンプルです。
WEBページの開発時に毎回行なう操作の自動化に使えると思いますが。。。

このサンプルでクリック操作を保存し再生する対象はリンクとボタンです。
また、マウスクリックのみ保存しています。ENTERキーは未対応です。

WEBページの操作(フォーム入力、リンクやボタン等のクリック)を記録し再生する
ツールはこちらです。WEB操作再生ツール(WebRecPlay)はWEBページの入力
操作やクリック操作を記録し再生するツールです。コマ送り再生やショートカット
からの再生が出来ます。このサンプルとはちょっと違う方法でWEBページの記録
再生を実現しています。

★フォームモジュール(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

    ' 最前面のIEのWEBページ(mshtml.IHTMLDocument)取得
    Public Sub GetIeObj()

        ' 最前面のIE取得
        Dim hwnd As Integer = FindWindowEx(0, 0, "IEFrame", vbNullString)

        ' IEに表示されているWEBページ(mshtml.IHTMLDocument)取得
        EnumChildWindows(hwnd, AddressOf EnumChildWindowsProc, 0)
    End Sub

    ' IEに表示されているWEBページ(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)

        ' IEクラス名チェック
        If strClass.ToLower = "internet explorer_server" Then
            ' WEBページ(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

    ' 文字列からNULL文字以降をカット
    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