向其他应用程序发送消息

Question

当前活动窗口为 DEPHI 做的程序界面，标题为“数据录入”，窗体上有十几个文本编辑框和 5 个下拉框，6个命令按钮，如何向其中第3个文本框发送键盘消息？或者说如何将光标移动到第3个文本框？相关的3 个API：
sendmessage
findwindow
exfindwindow

Answer 1

文本框可以处理以下消息：
 
EM_CANUNDO  
EM_CHARFROMPOS  
EM_EMPTYUNDOBUFFER  
EM_FMTLINES  
EM_GETFIRSTVISIBLELINE  
EM_GETHANDLE  
EM_GETIMESTATUS   
EM_GETLIMITTEXT  
EM_GETLINE  
EM_GETLINECOUNT  
EM_GETMARGINS  
EM_GETMODIFY  
EM_GETPASSWORDCHAR  
EM_GETRECT  
EM_GETSEL  
EM_GETTHUMB  
EM_GETWORDBREAKPROC  
EM_LIMITTEXT  
EM_LINEFROMCHAR  
EM_LINEINDEX  
EM_LINELENGTH  
EM_LINESCROLL  
EM_POSFROMCHAR  
EM_REPLACESEL  
EM_SCROLL  
EM_SCROLLCARET  
EM_SETHANDLE  
EM_SETIMESTATUS   
EM_SETLIMITTEXT  
EM_SETMARGINS  
EM_SETMODIFY  
EM_SETPASSWORDCHAR  
EM_SETREADONLY  
EM_SETRECT  
EM_SETRECTNP  
EM_SETSEL  
EM_SETTABSTOPS  
EM_SETWORDBREAKPROC  
EM_UNDO  
EN_CHANGE  
EN_ERRSPACE  
EN_HSCROLL  
EN_KILLFOCUS  
EN_MAXTEXT  
EN_SETFOCUS  
EN_UPDATE  
EN_VSCROLL  
WM_COMMAND  
WM_COPY  
WM_CTLCOLOREDIT  
WM_CUT  
WM_PASTE  
WM_UNDO

Answer 2

楼主你说的是DELPHI还是VB呀，可果是delphi可以到DELphi我想那儿人比较多的

Answer 3

spy++  可以清楚的看到每一个控件ID值，然后你再根据ID值，用GetDlgItem得到文本框的hwnd,得到句柄估计狼兄可以轻易的搞定了吧。

Answer 4

Option ExplicitPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As LongPublic Const WM_USER = &H400
Public Const WM_COPYDATA = &H4A
Public Const GWL_WNDPROC = (-4)Public Const APP_COMMAND As Long = 1
Public Const APP_MSG_LENGTH As Long = 256Public Type COPYDATASTRUCT
        dwData As Long
        cbData As Long
        lpData  As Long
End Type
Public Function CheckIsRuning(hWnd As Long)
    If App.PrevInstance Then
        Dim strMsg As String, nLenMsg As Integer
        strMsg = Command
        nLenMsg = LenB(strMsg)
        If nLenMsg < APP_MSG_LENGTH And nLenMsg > 0 Then
            Call SendOpenMessage(strMsg, hWnd)
        End If
        End
    End If
End FunctionPrivate Function SendOpenMessage(ByVal strMsg As String, hWnd As Long)
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------
    Dim lngHWnd As Long
    Dim MyData As COPYDATASTRUCT
    Dim bytMsg() As Byte
    lngHWnd = FindWindow(vbNullString, APP_TITLE)
    If lngHWnd <> 0 Then
        bytMsg = StrConv(strMsg, vbFromUnicode)
        MyData.dwData = APP_COMMAND
        MyData.cbData = UBound(bytMsg) + 1
        MyData.lpData = VarPtr(bytMsg(0))
        Call SendMessage(lngHWnd, WM_COPYDATA, hWnd, ByVal VarPtr(MyData))
    End If
    '------------------------------------------------
    Exit Function
    '----------------
ToExit:
    MsgBox "[ERROR](SendOpenMessage)" & Err.Description
End Function
Option ExplicitPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private m_OldWindowProc As Long
Public Function SetMyWindowProc(bOn As Boolean, hWnd As Long)
If bOn Then
    m_OldWindowProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf NewWindowProc)
Else
    Call SetWindowLong(hWnd, GWL_WNDPROC, m_OldWindowProc)
End If
End FunctionPrivate Function NewWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error GoTo psErr
    Dim MyData As COPYDATASTRUCT
    Dim strMsg As String
    Dim bytMsg() As Byte
    Select Case Msg
    Case WM_COPYDATA
        Call CopyMemory(MyData, ByVal lParam, LenB(MyData))
        Select Case MyData.dwData
            Case APP_COMMAND
                ReDim bytMsg(0 To MyData.cbData - 1)
                Call CopyMemory(bytMsg(0), ByVal MyData.lpData, MyData.cbData)
                strMsg = StrConv(bytMsg, vbUnicode)
                Call g_frmMain.ShowMessage(strMsg)
                g_frmMain.Show
        End Select
    End Select
    NewWindowProc = CallWindowProc(m_OldWindowProc, hWnd, Msg, wParam, lParam)
    Exit Function
psErr:
    MsgBox "错误:NewWindowProc" & Err.Description
End FunctionOption ExplicitPublic Const APP_TITLE As String = "MY EXE" '窗口标题'Global g_frmMain As Form1Sub main()
Set g_frmMain = New Form1
Load g_frmMain
g_frmMain.Show
End Sub

Answer 5

楼上高手，Mark一下，明天学习一下！

Answer 6

to  wwqna(york):spy++  可以清楚的看到每一个控件ID值，然后你再根据ID值
--------------------------------------------------------
不可能。烂机子无光驱，无软驱，无USB接口，只有一个带帮助的VB5。

Answer 7

to  51365133(渊海) :整理了一下：
form:
Option ExplicitPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private m_OldWindowProc As Long
Public Function SetMyWindowProc(bOn As Boolean, hWnd As Long)
If bOn Then
    m_OldWindowProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf NewWindowProc)
Else
    Call SetWindowLong(hWnd, GWL_WNDPROC, m_OldWindowProc)
End If
End FunctionPrivate Function NewWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error GoTo psErr
    Dim MyData As COPYDATASTRUCT
    Dim strMsg As String
    Dim bytMsg() As Byte
    Select Case Msg
    Case WM_COPYDATA
        Call CopyMemory(MyData, ByVal lParam, LenB(MyData))
        Select Case MyData.dwData
            Case APP_COMMAND
                ReDim bytMsg(0 To MyData.cbData - 1)
                Call CopyMemory(bytMsg(0), ByVal MyData.lpData, MyData.cbData)
                strMsg = StrConv(bytMsg, vbUnicode)
                Call g_frmMain.ShowMessage(strMsg)
                g_frmMain.Show
        End Select
    End Select
    NewWindowProc = CallWindowProc(m_OldWindowProc, hWnd, Msg, wParam, lParam)
    Exit Function
psErr:
    MsgBox "错误:NewWindowProc" & Err.Description
End Functionbas:
Option ExplicitPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As LongPublic Const WM_USER = &H400
Public Const WM_COPYDATA = &H4A
Public Const GWL_WNDPROC = (-4)Public Const APP_COMMAND As Long = 1
Public Const APP_MSG_LENGTH As Long = 256Public Type COPYDATASTRUCT
        dwData As Long
        cbData As Long
        lpData  As Long
End TypePublic Const APP_TITLE As String = "MY EXE" '窗口标题'Global g_frmMain As Form1Public Function CheckIsRuning(hWnd As Long)
    If App.PrevInstance Then
        Dim strMsg As String, nLenMsg As Integer
        strMsg = Command
        nLenMsg = LenB(strMsg)
        If nLenMsg < APP_MSG_LENGTH And nLenMsg > 0 Then
            Call SendOpenMessage(strMsg, hWnd)
        End If
        End
    End If
End FunctionPrivate Function SendOpenMessage(ByVal strMsg As String, hWnd As Long)
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------
    Dim lngHWnd As Long
    Dim MyData As COPYDATASTRUCT
    Dim bytMsg() As Byte
    lngHWnd = FindWindow(vbNullString, APP_TITLE)
    If lngHWnd <> 0 Then
        bytMsg = StrConv(strMsg, vbFromUnicode)
        MyData.dwData = APP_COMMAND
        MyData.cbData = UBound(bytMsg) + 1
        MyData.lpData = VarPtr(bytMsg(0))
        Call SendMessage(lngHWnd, WM_COPYDATA, hWnd, ByVal VarPtr(MyData))
    End If
    '------------------------------------------------
    Exit Function
    '----------------
ToExit:
    MsgBox "[ERROR](SendOpenMessage)" & Err.Description
End FunctionSub main()
Set g_frmMain = New Form1
Load g_frmMain
g_frmMain.Show
End Sub没看明白。

Answer 8

to tztz520(午夜逛街) :可以找到文本框,但就是不知道怎么分辨出哪个是第三个文件框.
------------------------------------------------------
就是这个问题。找文本框比较简单：http://blog.csdn.net/northwolves/archive/2004/10/24/149862.aspx

Answer 9

要不就自己写一个类似SPY++的东西
你可以先SetCapture,再根据鼠标所在的位置，在用ClientToScreen
再用WindowFromPoint,可以得到鼠标当前所在控件或窗体的句柄
然后再用GetDlgCtrlID,就可以得到它的ID值了。

Answer 10

to  wwqna(york) :要不就自己写一个类似SPY++的东西
你可以先SetCapture,再根据鼠标所在的位置，在用ClientToScreen
再用WindowFromPoint,可以得到鼠标当前所在控件或窗体的句柄
然后再用GetDlgCtrlID,就可以得到它的ID值了。
-----------------------谢谢，我试试

Answer 11

modual 模块的：
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Declare Function ReleaseCapture Lib "user32" () As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As LongPublic Const WM_GETTEXT = &HD
Type POINTAPI
    x As Long
    y As Long
End Type
form 模块的：Private Sub Form_Load()
    Check1.Value = 1
    SetOnTop (Check1.Value)
    IsDragging = False
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If IsDragging = True Then
    Dim rtn As Long, curwnd As Long
    Dim tempstr As String
    Dim strlong As Long
    Dim point As POINTAPI
    point.x = x
    point.y = y
    '将客户坐标转化为屏幕坐标并显示在PointText文本框中
    If ClientToScreen(frmMain.hwnd, point) = 0 Then Exit Sub
    PointText.Text = Str(point.x) + "," + Str(point.y)
    '获得鼠标所在的窗口句柄并显示在hWndText文本框中
    curwnd = WindowFromPoint(point.x, point.y)
    hWndText.Text = Str(curwnd)
    '获得该窗口的类型并显示在WndClassText文本框中
    tempstr = Space(255)
    strlong = Len(tempstr)
    rtn = GetClassName(curwnd, tempstr, strlong)
    If rtn = 0 Then Exit Sub
    tempstr = Trim(tempstr)
    WndClassText.Text = tempstr
    '向该窗口发送一个WM_GETTEXT消息，以获得该窗口的文本，并显示在PasswordText文本框中
    tempstr = Space(255)
    strlong = Len(tempstr)
    rtn = SendMessage(curwnd, WM_GETTEXT, strlong, tempstr)
    tempstr = Trim(tempstr)
    PasswordText.Text = tempstr
End If
    
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If IsDragging = True Then
    Screen.MousePointer = vbDefault
    IsDragging = False
    '释放鼠标消息抓取
    ReleaseCapture
End If
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If IsDragging = False Then
    IsDragging = True
    Screen.MouseIcon = LoadPicture(App.Path + "\pass.ico")
    Screen.MousePointer = vbCustom
    '将以后的鼠标输入消息都发送到本程序窗口
    SetCapture (frmMain.hwnd)
End If
   
End Sub

Answer 12

顶，如何向其他程序发送自定义消息呢？WM_COMM  
 public const WM_COMM = WM_USER + 100