■VB.Netのキーストローク合成ではまる

 キーストローク合成ではまった話です。
 キーストロークを合成し、プログラムでキーの入力を行う事が出来ます。

 使い方としては
 ・クリップボードにデータをセット
 ・Alt+Escでウィンドウの切替
 ・Ctrl+Vで貼り付け
 こんな感じで目的のアプリケーションにクリップボードの内容を貼り付けます。

 実際の動きを解説すると
 ・VBのアプリケーションで処理開始(ボタンクリック等を行うのでVBのアプリケーションにフォーカスがある)
 ・Alt+Escでは直前にフォーカスのあったアプリケーションに切替が出来ます。
 ・そしてクリップボードにセットしたデータを貼り付けると言う訳です。

 コード入力等VBで一覧を作り、クリックしたコードを入力(貼り付け)出来る物を作れます。

 そんなアプリケーションを作って動かしていたのですが
 テスト(ソフトのバージョンアップ確認)をやっていると動かなくなりました。

 以前も同じような事があり、その時はアプリケーションが切り替わる前に貼り付け
 されていて、ウェイトを入れる事によって対処しました。

 しかし今回は違い、調べてみるとExcelやメモ帳への貼り付けは問題無く出来ており、
 今回バージョンアップしたアプリケーションへの貼り付けのみが上手く行かない状態でした。
 
 かなり悩んで色々調べましたが判明した対処方法は
 VBのアプリケーションを管理者権限で動かすと言う方法でした。
 Windowsのセキュリティが強化された事による問題のようです。
 
 最初Altキーが押しっぱなしになっていると思っていましたが
 アプリケーションの切替後はキーストロークの合成が全く上手く
 動作しない状況だったようです。
 原因がプログラムでは無いだけあって見つけるのに苦労しました。

 その時調べたKeybd_eventに変わるSendInputを使ったサンプル

Imports System.Runtime.InteropServices

Public Class Form1
    'SendInput によるキーストローク合成

    'KEYBDINPUT構造体
    <StructLayout(LayoutKind.Sequential)> _
    Private Structure KEYBDINPUT
        Public wVk As Short
        Public wScan As Short
        Public dwFlags As Integer
        Public time As Integer
        Public dwExtraInfo As Integer
        Public dumy1 As Integer
        Public dumy2 As Integer
    End Structure

    'SendInputの引数データ
    <StructLayout(LayoutKind.Sequential)> _
    Private Structure INPUT
        Public type As Integer
        Public ki As KEYBDINPUT
    End Structure

    'キーストローク合成DLL
    <DllImport("user32.dll")> _
    Private Shared Sub SendInput( _
        ByVal nInputs As Integer, _
        ByRef pInputs As INPUT, _
        ByVal cbsize As Integer)
    End Sub

    'キーコードをスキャンコードに変換するDLL
    <DllImport("user32.dll", EntryPoint:="MapVirtualKeyA")> _
    Private Shared Function MapVirtualKey( _
        ByVal wCode As Integer, _
        ByVal wMapType As Integer) As Integer
    End Function

    '現在のスレッドに関するメッセージの拡張情報を取得するDLL
    'メッセージの拡張情報とは、現在のスレッドのメッセージキューに関連付けられている、アプリケーション定義またはドライバ定義の 32 ビット値です。
    <DllImport("user32.dll")> _
    Private Shared Function GetMessageExtraInfo() _
        As IntPtr
    End Function

    '定数
    'type指定
    Private Const INPUT_KEYBOARD = 1            'キーボードイベント
    'キーボード入力の指定用
    Private Const KEYEVENTF_KEYDOWN = &H0       'キーを押す
    Private Const KEYEVENTF_KEYUP = &H2         'キーを離す
    Private Const KEYEVENTF_EXTENDEDKEY = &H1   '拡張コード

    Private Function ExtendedKeyFlag(ByVal Key As System.Windows.Forms.Keys) As Integer
        'スキャンコードの設定
        '特定のキーの場合KEYEVENTF_EXTENDEDKEYを指定する必要がある
        Dim Flag As Integer = 0
        Select Case Key
            'Cancel     :? Control+Pause
            'Divide     :除算記号(/)キー
            'RShiftKey  :右のShiftキー
            'RControlKey:右のCtrlキー
            'RMenu      :右のAltキー
            Case Keys.Cancel, Keys.PageUp, Keys.PageDown, Keys.End, Keys.Home, _
                 Keys.Left, Keys.Up, Keys.Right, Keys.Down, _
                 Keys.PrintScreen, Keys.Insert, Keys.Delete, _
                 Keys.Divide, Keys.NumLock, Keys.RShiftKey, Keys.RControlKey, Keys.RMenu
                Flag = KEYEVENTF_EXTENDEDKEY< BR >         End Select
        Return Flag

    End Function

    Sub Wait(ByVal Wait_Time As Long)
        '指定ミリ秒のウェイト
        'System.Threading.Thread.Sleep(Wait_Time)
        Dim t10 As Integer
        t10 = Environment.TickCount< BR >         Do Until Environment.TickCount > t10 + Wait_Time
            System.Windows.Forms.Application.DoEvents()
        Loop
    End Sub

    Private Sub SendInput_Rtn(ByVal Key_Code As System.Windows.Forms.Keys, ByVal Fl_Down As Boolean)
        Dim inp As INPUT = New INPUT
        'Key_Code : 押す、又は放すキーボードのキー
        'Fl_Down  : Trueで押す、Falseで離す

        inp.type = INPUT_KEYBOARD 'タイプ:キーボード
        inp.ki.wVk = Key_Code 'キーコード指定
        inp.ki.wScan = MapVirtualKey(inp.ki.wVk, 0) 'スキャンコード
        If Fl_Down = True Then 'Fl_Downによって押す、離すに分ける
            inp.ki.dwFlags = ExtendedKeyFlag(inp.ki.wVk) Or KEYEVENTF_KEYDOWN
        Else
            inp.ki.dwFlags = ExtendedKeyFlag(inp.ki.wVk) Or KEYEVENTF_KEYUP
        End If
        inp.ki.dwExtraInfo = GetMessageExtraInfo() 'メッセージの拡張情報
        inp.ki.time = 0
        SendInput(1, inp, Marshal.SizeOf(inp)) 'キーボードエミュレート開始
    End Sub


    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        'Alt+Escでフォーカスを移動し、Ctrl+Vで貼り付けを行う。
        Dim inp As INPUT = New INPUT

        SendInput_Rtn(Keys.Menu, True)   'Altキーを押す
        SendInput_Rtn(Keys.Escape, True) 'Escキーを押す(Alt + Esc ウィンドウ切替)
 
        Call Wait(50)

        SendInput_Rtn(Keys.Escape, False) 'Altキーを離す
        SendInput_Rtn(Keys.Menu, False)   'Escキーを離す

        Call Wait(50)

        Clipboard.SetText("01234567890123") 'クリップボードにデータをセット

        ' キーボードを押す
        SendInput_Rtn(Keys.ControlKey, True) 'Ctrlキーを押す
        SendInput_Rtn(Keys.V, True)          'Vキーを押す(Ctrl+V 貼り付け)
  
        Call Wait(50)

        SendInput_Rtn(Keys.ControlKey, False) 'Ctrlキーを離す
        SendInput_Rtn(Keys.V, False)          'Vキーを離す
     End Sub
End Class

ボタンをクリックするとクリップボードに値をセットし、アプリケーションを切り替えて貼り付けます。
今回色々調べてスキャンコードが必要無い時に付けると問題がある場合がある等
の問題やメッセージの拡張情報せっと等もりこみました。
ただ今回の対処法で必要なくなってしまいましたが。


トップへ戻る