VB关闭其他进程的输入法

新建上面的几个按钮和list，打开记事本或者win32pad，单击向记事本发送消息，程序会按ctrl+空格关闭中文输入法，并发送aaa到记事本。只适用于前台进程。

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) 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

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_MOUSEACTIVATE = &H21

'以下几个API用于关闭前台进程输入法：

'-------------------------------------------------------------------------------------------------------

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

Private Declare Function GetCurrentThread Lib "kernel32" () As Long

Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long

Private Declare Function ImmIsIME Lib "imm32.dll" (ByVal hkl As Long) As Long

Private Declare Function ImmGetDescription Lib "imm32.dll" Alias "ImmGetDescriptionA" (ByVal hkl As Long, ByVal lpsz As String, ByVal ubuflen As Long) As Long

'-------------------------------------------------------------------------------------------------------

Private Sub Command1_Click()

'查找记事本句柄

Dim dHwnd As Long

Dim tHwnd As Long

dHwnd = FindWindow("Notepad", vbNullString)

If dHwnd > 0 Then

tHwnd = FindWindowEx(dHwnd, ByVal 0&, "Edit", vbNullString)

End If

SetForegroundWindow tHwnd

SendMessage tHwnd, 33, 0, 0

Sleep 2000 '延迟2秒确保窗口带到前台

'以下代码把前台进程的输入法关闭：

'-------------------------------------------------------------------------------------------------------

Dim hwnd As Long

Dim hCurThread As Long

Dim sCaption As String

Dim sBuffer As String

Dim hCurKBDLayout As Long

hwnd = GetForegroundWindow

sCaption = Space(255)

GetWindowText hwnd, sCaption, 255

If InStr(sCaption, Chr(0)) Then

sCaption = Left(sCaption, InStr(sCaption, Chr(0)) - 1)

End If

hCurThread = GetWindowThreadProcessId(hwnd, ByVal 0&)

hCurKBDLayout = GetKeyboardLayout(hCurThread)

If ImmIsIME(hCurKBDLayout) = 1 Then

sBuffer = Space(255)

RetCount = ImmGetDescription(ByVal hCurKBDLayout, sBuffer, 255)

sBuffer = Left(sBuffer, InStr(sBuffer, Chr(0)) - 1)

Else

sBuffer = "English(American)"

End If

List1.AddItem "当前窗口标题：" & sCaption

List1.AddItem " 当前输入法： " & sBuffer

If sBuffer <> "English(American)" Then SendKeys "^ "

Sleep 1000 '延迟1秒确保ctrl+空格生效

'-------------------------------------------------------------------------------------------------------

SendKeys "aaa"

' MsgBox pwszKLID

End Sub

Private Sub Command2_Click()

'查找win32pad句柄

Dim dHwnd As Long

Dim tHwnd As Long

dHwnd = FindWindow("win32padClass", vbNullString)

If dHwnd > 0 Then

tHwnd = FindWindowEx(dHwnd, ByVal 0&, "RichEdit20A", vbNullString)

End If

SetForegroundWindow tHwnd '把父窗体带到前台

SendMessage tHwnd, 33, 0, 0 '把子窗体带到前台

Sleep 2000 '延迟2秒确保窗口带到前台

'以下代码把前台进程的输入法关闭：

'-------------------------------------------------------------------------------------------------------

Dim hwnd As Long

Dim hCurThread As Long

Dim sCaption As String

Dim sBuffer As String

Dim hCurKBDLayout As Long

hwnd = GetForegroundWindow

sCaption = Space(255)

GetWindowText hwnd, sCaption, 255

If InStr(sCaption, Chr(0)) Then

sCaption = Left(sCaption, InStr(sCaption, Chr(0)) - 1)

End If

hCurThread = GetWindowThreadProcessId(hwnd, ByVal 0&)

hCurKBDLayout = GetKeyboardLayout(hCurThread)

If ImmIsIME(hCurKBDLayout) = 1 Then

sBuffer = Space(255)

RetCount = ImmGetDescription(ByVal hCurKBDLayout, sBuffer, 255)

sBuffer = Left(sBuffer, InStr(sBuffer, Chr(0)) - 1)

Else

sBuffer = "English(American)"

End If

List1.AddItem "当前窗口标题：" & sCaption

List1.AddItem " 当前输入法： " & sBuffer

If sBuffer <> "English(American)" Then SendKeys "^ "

Sleep 1000 '延迟1秒确保ctrl+空格生效

'-------------------------------------------------------------------------------------------------------

SendKeys "aaa"

End Sub

Private Sub Command3_Click()