SendInput VB Basic Example

后端 未结 2 1441
耶瑟儿~
耶瑟儿~ 2021-01-14 04:03

I hope someone can assist, I trying to find an example of a SendInput code that simulate keyboard commands, I wish to find the notepad window and enter a test message.

相关标签:
2条回答
  • 2021-01-14 04:14

    The following code is not for VB.net but VB/VBA, its similar to the sendkeys method but probably a little more reliable as it sends the keys specifically to the target application. (the post where i got it shows the sendkeys method too)

    Public Declare Function FindWindowX Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _
    ByVal hWnd2 As Long, ByVal lpsz1 As Long, ByVal lpsz2 As Long) As Long
    
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Integer) As Long
    
    Private Const WM_KEYDOWN = &H100
    Private Const WM_KEYUP = &H101
    
    Sub Three()
        hWind = FindWindow(vbNullString, "Untitled - Notepad")
        cWind = FindWindowX(hWind, 0, 0, 0)
        Debug.Print PostMessage(cWind, WM_KEYDOWN, vbKeyA, 0)
        Debug.Print PostMessage(cWind, WM_KEYDOWN, vbKeyB, 0)
        Debug.Print PostMessage(cWind, WM_KEYDOWN, vbKeyC, 0)
    End Sub
    

    Code taken from this forum post

    If you paste this into a new module in Excel/VBA and have an new instance of notepad running, when the sub is executed "abc" should appear in notepad.

    I don't see how using this, or the sendkeys method could "damage" the target window. So long as you time the messages properly (not sending tonnes of characters to the window all at the same time) it shouldn't cause any problems.

    0 讨论(0)
  • 2021-01-14 04:34

    I had managed to find another SendInput script online, I have copied it below for anyone else who may be interested.

    I have been using SendKeys to copy data from a spreadsheet and enter these on a system at work, this saves valuable time as there is a vast amount of information that needs to be entered.

    The SendKeys function worked without any issues (although due to reliability issues I had to consider alternatives), will the SendInput cause any issues to the other window i.e. other than simulating keyboard buttons will it interfere with any other functions of the target window?

    Private Declare Function SendInput Lib "user32.dll" _
     (ByVal nInputs As Long, ByRef pInputs As Any, _
     ByVal cbSize As Long) As Long
    Private Declare Function VkKeyScan Lib "user32" Alias "VkKeyScanA" _
     (ByVal cChar As Byte) As Integer
    
    Private Type KeyboardInput      '   typedef struct tagINPUT {
     dwType As Long                '     DWORD type;
     wVK As Integer                '     union {MOUSEINPUT mi;
     wScan As Integer              '               KEYBDINPUT ki;
     dwFlags As Long               '               HARDWAREINPUT hi;
     dwTime As Long                '              };
     dwExtraInfo As Long           '     }INPUT, *PINPUT;
     dwPadding As Currency         '   8 extra bytes, because mouses take more.
    End Type
    
    Private Const INPUT_MOUSE As Long = 0
    Private Const INPUT_KEYBOARD As Long = 1
    Private Const KEYEVENTF_KEYUP As Long = 2
    Private Const VK_LSHIFT = &HA0
    
    Public Sub SendKey(ByVal Data As String)
    Dim ki() As KeyboardInput
    Dim i As Long
    Dim o As Long ' output buffer position
    Dim c As String ' character
    
    ReDim ki(1 To Len(Data) * 4) As KeyboardInput
    o = 1
    
    For i = 1 To Len(Data)
     c = Mid$(Data, i, 1)
     Select Case c
       Case "A" To "Z": ' upper case
         ki(o).dwType = INPUT_KEYBOARD 'shift down
         ki(o).wVK = VK_LSHIFT
         ki(o + 1) = ki(o) ' key down
         ki(o + 1).wVK = VkKeyScan(Asc(c))
         ki(o + 2) = ki(o + 1) ' key up
         ki(o + 2).dwFlags = KEYEVENTF_KEYUP
         ki(o + 3) = ki(o) ' shift up
         ki(o + 3).dwFlags = KEYEVENTF_KEYUP
         o = o + 4
       Case Else: ' lower case
         ki(o).dwType = INPUT_KEYBOARD
         ki(o).wVK = VkKeyScan(Asc(c))
         ki(o + 1) = ki(o)
         ki(o + 1).dwFlags = KEYEVENTF_KEYUP
         o = o + 2
     End Select
    Next i
    
    Debug.Print SendInput(o - 1, ki(1), LenB(ki(1))),
    'Debug.Print Err.LastDllError
    End Sub
    
    Private Sub Command1_Click()
    Text1.Text = ""
    Text1.SetFocus
    DoEvents
    Call SendKey("This Is A Test")
    End Sub
    
    0 讨论(0)
提交回复
热议问题