NonSoft

WEBページに自動入力するサンプル(VB.NET)


 サンプル(ソース/コード)
WEBページのフォームにデータを自動入力するサンプルです。IE専用です。
WEBページの開発時に毎回入力するデータの自動入力に使えると思います。。。
WEBページに自動入力する方法はいろいろありますが、このサンプルは
SendMessageのWM_IME_CHARで一文字ずつ文字送信しています。また、
次項目へ移動する時はPostMessageのWM_KEYDOWNでTABキーを送信しています。

このサンプルではYahooのログインページにユーザIDとパスワードを入力します。
YahooのログインページのユーザIDにフォーカスを設定してお試しください。

WEBページのフォームにデータを自動入力するツールはこちらです。
WEB自動入力ツール(WebFormInput)はWEBページに入力したデータを
保存し次回以降は自動入力するツールです。事前登録情報のフォーカス位置に
コピーする事も出来ます。このサンプルとはちょっと違う方法でWEBページの
自動入力を実現しています。

★フォームモジュール(Form1.vb)
Public Class Form1
    Private Sub Button1_Click( _
        ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles Button1.Click
        ' YahooのログインページにユーザIDとパスワードを設定するサンプル
        Dim colData As New Collection
        colData.Add("あいうえ")     ' ユーザID
        colData.Add("1234")         ' パスワード

        ' WEBページのフォームにデータ設定
        SetWebFormValue(colData)
    End Sub
End Class

★標準モジュール(Form1.vb)
Module Module1
    ' APIの定義
    Private Const WM_KEYDOWN = &H100
    Private Const WM_IME_CHAR = &H286
    Private Delegate Function D_EnumWindowsProc( _
        ByVal hWnd As Integer, ByVal lParam As Integer) As Integer
    Private Delegate Function D_EnumChildWindowsProc(
        ByVal hWnd As Integer, ByVal lParam As Integer) As Integer
    Private Declare Function EnumWindows Lib "user32.dll" _
        (ByVal lpEnumFunc As D_EnumWindowsProc, 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 PostMessage Lib "user32.dll" Alias "PostMessageA" _
        (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
         ByVal lParam As Integer) As Integer
    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
        (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
         ByVal lParam As Integer) As Integer

    ' WEBページのフォームに設定するデータのコレクション
    Private colFormVal As New Collection

    ' 終了フラグ
    Private blnEndFlag As Boolean = False

    ' 最前面のWEBページのフォームにデータ設定
    Public Sub SetWebFormValue(ByVal col As Collection)
        ' フォームに設定するデータのコレクション
        colFormVal = col

        ' 終了フラグ
        blnEndFlag = False

        ' トップレベルウィンドウの全てハンドル取得して、
        ' 最前面のWEBページのフォームにデータ設定
        Dim intRet As Integer = EnumWindows(AddressOf EnumWindowsProc, 0)
    End Sub

    ' トップレベルウィンドウの全てハンドル取得して、
    ' 最前面のWEBページのフォームにデータ設定
    Public Function EnumWindowsProc( _
        ByVal hWnd As Integer, ByVal lParam As Integer) As Integer

        ' 指定された親ウィンドウに属するWEBページのフォームにデータ設定
        EnumChildWindows(hWnd, AddressOf EnumChildWindowsProc, 0)
        If blnEndFlag Then
            ' リターン
            Return 0
        End If

        ' リターン
        Return 1
    End Function

    ' 指定された親ウィンドウに属するWEBページのフォームにデータ設定
    Private Function EnumChildWindowsProc( _
        ByVal hWnd As Integer, ByVal lParam As Integer) As Integer
        Dim stt As StackTrace = New StackTrace(False)
        Dim cls As String = stt.GetFrame(0).GetMethod().ReflectedType.FullName
        Dim mth As String = stt.GetFrame(0).GetMethod().Name

        ' クラス名取得
        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ページのフォームにデータ設定
            For i As Integer = 1 To colFormVal.Count
                ' フォームのカーソル位置に1文字づつ入力
                Dim strDat As String = colFormVal(i)
                For j As Integer = 0 To strDat.Length - 1
                    SendMessage(hWnd, WM_IME_CHAR, Asc(strDat.Substring(j, 1)), 0)
                Next
                ' 文字列の入力が完了したらTAB送信(次項目へ)
                PostMessage(hWnd, WM_KEYDOWN, Asc(vbTab), &H1E)
            Next

            ' 最前面のWEBページのみ対象なので終了
            blnEndFlag = True

            ' リターン
            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