等待直到处理PostMessage API击键

时间:2019-12-26 14:04:04

标签: excel vba sendmessage postmessage

我正在尝试将击键可靠地发送到其他程序。下面的程序是用Excel VBA编写的,通过在记事本中键入来测试相关的Windows API。我既想输入单词,又要使用快捷键,例如Ctrl + A

问题在于 PostMessage 不等待窗口处理消息。当程序稍后“按下Control”时,某些先前的按键操作尚未得到处理,并且它们也获得了Control修饰符,因此在这种情况下,仅键入pdf时可能会弹出对话框进行打印。

从理论上讲, SendMessage 将是此问题的理想解决方案,因为据我了解,它等待消息被处理。但是,当我尝试将程序更改为 SendMessage 时,使用Ctrl + A进行全部选择不起作用。输出是大写字母,好像也按住不动。

'basic declarations
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

'pressing key normally
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_CHAR = &H102

'control / shift declaration
Public Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Const VK_SHIFT = &H10
Public Const VK_CONTROL = &H11
Public Const KEYEVENTF_KEYUP = &H2

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'requires notepad to be open
Sub TestTypingPM()
hwind = FindWindow("Notepad", vbNullString)
cwind = FindWindowX(hwind, 0, 0, 0)

If hwind = 0 Then
    MsgBox "Open Notepad for this program to work."
    Exit Sub
End If

For i = 1 To 3
'pressing normal buttons
Call PostMessage(cwind, WM_KEYDOWN, vbKeyP, 0)
Call PostMessage(cwind, WM_KEYDOWN, vbKeyD, 0)
Call PostMessage(cwind, WM_KEYDOWN, vbKeyF, 0)
'pressing enter
Call PostMessage(cwind, WM_KEYDOWN, vbKeyReturn, 0)
Next

'select all
keybd_event VK_CONTROL, 0, 0, 0
Sleep (10)
Call PostMessage(cwind, WM_KEYDOWN, vbKeyA, 0)
 keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
End Sub

Sub TestTypingSM()
hwind = FindWindow("Notepad", vbNullString)
cwind = FindWindowX(hwind, 0, 0, 0)

If hwind = 0 Then
    MsgBox "Open Notepad for this program to work."
    Exit Sub
End If

For i = 1 To 3
'pressing normal buttons
Call SendMessage(cwind, WM_CHAR, vbKeyP, 0)
Call SendMessage(cwind, WM_CHAR, vbKeyD, 0)
Call SendMessage(cwind, WM_CHAR, vbKeyF, 0)
'pressing enter
Call SendMessage(cwind, WM_CHAR, vbKeyReturn, 0)
Next

'select all
keybd_event VK_CONTROL, 0, 0, 0
Sleep (10)
Call SendMessage(cwind, WM_CHAR, vbKeyA, 0)
 keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
End Sub

0 个答案:

没有答案