向记事本发送字符postmessage方法

icecept

'*************************************************************************
'**模 块 名：Form1
'**说    明：魔灵圣域 版权所有2008 - 2009(C)
'**创 建 人：郭卫
'**日    期：2008-01-10 11:25:14
'**修 改 人：
'**日    期：
'**描    述：
'**版    本：V1.0.0
'*************************************************************************
Option Explicit
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
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 Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_CHAR = &H102
Function MakeKeyLparam(ByVal VirtualKey As Long, ByVal flag As Long) As Long
    Dim s As String
    Dim Firstbyte As String    'lparam参数的24-31位
    If flag = WM_KEYDOWN Then  '如果是按下键
        Firstbyte = "00"
    Else
        Firstbyte = "C0"       '如果是释放键
    End If
    Dim Scancode As Long
    '获得键的扫描码
    Scancode = MapVirtualKey(VirtualKey, 0)
    Dim Secondbyte As String   'lparam参数的16-23位，即虚拟键扫描码
    Secondbyte = Right("00" & Hex(Scancode), 2)
    s = Firstbyte & Secondbyte & "0001"  '0001为lparam参数的0-15位，即发送次数和其它扩展信息
    MakeKeyLparam = Val("&H" & s)
End Function
Private Sub Form_Load()
    Shell "notepad.exe", vbNormalFocus
    Dim NotepadHwnd As Long, hwnd As Long
    NotepadHwnd = FindWindow("notepad", vbNullString)
    '得到窗口类名为Edit的窗口句柄
    hwnd = FindWindowEx(NotepadHwnd, 0, "Edit", vbNullString)
    PostMessage hwnd, WM_KEYDOWN, vbKeyA, MakeKeyLparam(vbKeyA, WM_KEYDOWN) '按下A键
    PostMessage hwnd, WM_CHAR, vbKeyS, MakeKeyLparam(vbKeyS, WM_KEYDOWN) '输入字符A
    PostMessage hwnd, WM_KEYUP, vbKeyY, MakeKeyLparam(vbKeyY, WM_KEYUP)   '释放A键
End Sub

bloodsoldier

用SendKeys char, True就行了

icecept

'**************************************************************************
'**模 块 名：工程1 - Form1
'**说    明：永远的魔灵 by icecept(郭卫）
'**创 建 人：icecept(魔灵)
'**日    期：2009-12-04 21:55:50
'**修 改 人：icecept(魔灵)
'**版    本：V1.0.0
'**E-mail  ：icecept@163.com    QQ：543375508
'**网    址：http://hi.baidu.com/icecept   http://icecept.jimdo.com
'*************************************************************************
Option Explicit
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 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 Const EM_REPLACESEL = &HC2
Private Const WM_SETTEXT = &HC
Dim ChildHwnd As Long          '记事本文本框的句柄
Dim NotepadHwnd As Long        '记事本的句柄
'向记事本的编辑框里输入字符,ChildHwnd
'改变记事本标题,NotepadHwnd
Private Sub Command1_Click()
    '    SendMessage(句柄, 消息, 0, ByVal 标题)
    Call SendMessage(NotepadHwnd, WM_SETTEXT, 0, ByVal "你好，我是郭卫")
End Sub
Private Sub Command2_Click()
    Dim i As Integer
    For i = 0 To List1.ListCount - 1
        '用EM_REPLACESEL可以追加字符
        SendMessage ChildHwnd, EM_REPLACESEL, 0, ByVal List1.List(i)
    Next i
End Sub
Private Sub Form_Load()
    With List1
        .AddItem "向记事本中打字"
        .AddItem "只要知道对方窗口的句柄"
        .AddItem "就可以轻易实现。"
    End With
    List1.ListIndex = 0
    Shell "notepad.exe", vbNormalFocus
    NotepadHwnd = FindWindow("notepad", vbNullString)
    '得到窗口类名为Edit的窗口句柄
    ChildHwnd = FindWindowEx(NotepadHwnd, 0, "Edit", vbNullString)
End Sub
Private Sub List1_Click()
    '每次一句，且会清掉以前的一句
    SendMessage ChildHwnd, WM_SETTEXT, 0, ByVal List1.List(List1.ListIndex)
End Sub
向记事本发送字符sendmessage.rar

icecept

Option Explicit
'键盘相关
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_KEYUP = &H2

Private Sub Form_Load()
    Shell "notepad.exe", vbNormalFocus
    Call keybd_event(vbKeyS, MapVirtualKey(vbKeyS, 0), 0, 0)                '按下S键。
    Call keybd_event(vbKeyS, MapVirtualKey(vbKeyS, 0), KEYEVENTF_KEYUP, 0)  '放开S键。
    Call keybd_event(vbKeyA, MapVirtualKey(vbKeyA, 0), 0, 0)                '按下A键。
    Call keybd_event(vbKeyA, MapVirtualKey(vbKeyA, 0), KEYEVENTF_KEYUP, 0)  '放开A键。
    Call keybd_event(vbKeyY, MapVirtualKey(vbKeyY, 0), 0, 0)                '按下y键。
    Call keybd_event(vbKeyY, MapVirtualKey(vbKeyY, 0), KEYEVENTF_KEYUP, 0)  '放开y键。
End Sub

icecept

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
    Show
    Shell "notepad.exe", vbNormalFocus
    AppActivate "无标题 - 记事本"
    SendKeys "H", True
    Sleep 50
    SendKeys "a", True
    Sleep 50
    SendKeys "p", True
    Sleep 50
    SendKeys "p", True
    Sleep 50
    SendKeys "y", True
    Sleep 50
    SendKeys "  ", True
    Sleep 50
    SendKeys "B", True
    Sleep 50
    SendKeys "i", True
    Sleep 50
    SendKeys "r", True
    Sleep 50
    SendKeys "t", True
    Sleep 50
    SendKeys "h", True
    Sleep 50
    SendKeys "d", True
    Sleep 50
    SendKeys "a", True
    Sleep 50
    SendKeys "y", True
    Sleep 50
    SendKeys "!", True
    Sleep 50
    SendKeys "%FS", True
    Sleep 50
    SendKeys "b", True
    Sleep 50
    SendKeys "i", True
    Sleep 50
    SendKeys "r", True
    Sleep 50
    SendKeys "t", True
    Sleep 50
    SendKeys "h", True
    Sleep 50
    SendKeys "%S", True
    Sleep 50
    DoEvents
'    SendKeys "%FX", True
End Sub

[ 本帖最后由 icecept 于 2008-1-11 10:46 编辑 ]

VBAdvisor

Vista don't support SendKey any more.

bloodsoldier

you should disable UAC in Vista

VBProFan

原帖由 VBAdvisor 于 2008-1-11 16:06 发表
Vista don't support SendKey any more.

Vista貌似是第三人称单数？ 所以后面应该跟 doesn't ？

icecept

Vista 我没有用过，希望有vista系统的给出在其系统上正常运行的源码，可让大家少走冤枉路

adsl794613

DO YOU KNOW HOW TO UES  FindWindow

SUCH AS  NotepadHwnd = FindWindow(vbNullString, "路由重拨号工具0.1")
NotepadHwnd = FindWindow(vbNullString, VBNULLSTRING)