VB关闭其他进程的输入法

http://files.cnblogs.com/files/liuzhaoyzz/%E5%85%B3%E9%97%AD%E5%85%B6%E4%BB%96%E8%BF%9B%E7%A8%8B%E8%BE%93%E5%85%A5%E6%B3%95IME.rar

新建上面的几个按钮和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()
End
End Sub