SendInput VB基本示例

Question

我希望有人可以提供幫助，我試圖找到一個模擬鍵盤命令的SendInput代碼的示例，我希望找到記事本窗口並輸入測試消息。

我最初在一個項目中使用SendKeys，SendKeys函數使我能夠將鍵盤命令轉發到我們在工作場所使用的定製軟件。

我希望有人可以幫忙，在互聯網上的例子似乎並沒有工作。

任何人都可以建議，如果SendInput方法是侵入性的，即它會導致任何損壞的收件人窗口。

SendKey方法有效，但可靠性似乎非常受打擊和錯過。

非常感謝

薩拉

編輯：

我發現下面的代碼在互聯網上，是繼SendInput方法？我注意到使用了'SendKey'這個詞嗎？

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 

Answer 1

以下代碼是不是VB.net但VB/VBA，其類似於SendKeys方法，但可能稍微更可靠的，因爲它發送鍵具體到目標應用程序。 （這裏我得到它後顯示SendKeys方法太）從this論壇的帖子

採取

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 

代碼如果你粘貼到Excel中/ VBA一個新的模塊，並有記事本運行的一個新實例，當子執行時「abc」應該出現在記事本中。

我不明白怎麼使用這個，或者sendkeys方法會「損害」目標窗口。只要你正確地記錄消息的時間（而不是同時發送大量字符到窗口），它不應該引起任何問題。

Answer 2

我已經設法在網上找到另一個SendInput腳本，我已經將其複製到了其他任何可能感興趣的人的下面。

我一直在使用SendKeys從電子表格複製數據並在工作系統中輸入這些數據，這樣可以節省寶貴的時間，因爲需要輸入大量的信息。

SendKeys功能沒有任何問題（儘管由於可靠性問題，我不得不考慮替代品），SendInput會導致任何問題到另一個窗口，即模擬鍵盤按鈕以外的任何問題是否會干擾目標的任何其他功能窗口？

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