向其他应用程序发送消息

northwolves 2004-10-31 02:38:52
当前活动窗口为 DEPHI 做的程序界面,标题为“数据录入”,窗体上有十几个文本编辑框和 5 个下拉框,6个命令按钮,如何向其中第3个文本框发送键盘消息?或者说如何将光标移动到第3个文本框?

相关的3 个API:
sendmessage
findwindow
exfindwindow
...全文
265 19 打赏 收藏 转发到动态 举报
写回复
用AI写文章
19 条回复
切换为时间正序
请发表友善的回复…
发表回复
zyp2kyear 2004-12-01
  • 打赏
  • 举报
回复
顶,如何向其他程序发送自定义消息呢?WM_COMM
public const WM_COMM = WM_USER + 100
wwqna 2004-11-04
  • 打赏
  • 举报
回复
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 Long

Public 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 Sub

Private 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 Sub

Private 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 Sub

Private 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
northwolves 2004-11-04
  • 打赏
  • 举报
回复
没搞定,大家再邦一把。

如何将光标移动到外部程序的多个文本框的第3个文本框?
northwolves 2004-11-01
  • 打赏
  • 举报
回复

to wwqna(york) :

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

谢谢,我试试
yiliao 2004-11-01
  • 打赏
  • 举报
回复
学习……
wwqna 2004-11-01
  • 打赏
  • 举报
回复
要不就自己写一个类似SPY++的东西
你可以先SetCapture,再根据鼠标所在的位置,在用ClientToScreen
再用WindowFromPoint,可以得到鼠标当前所在控件或窗体的句柄
然后再用GetDlgCtrlID,就可以得到它的ID值了。
熊孩子开学喽 2004-10-31
  • 打赏
  • 举报
回复
顶一下再说,我也不知道。
aohan 2004-10-31
  • 打赏
  • 举报
回复
学习
northwolves 2004-10-31
  • 打赏
  • 举报
回复
to tztz520(午夜逛街) :

可以找到文本框,但就是不知道怎么分辨出哪个是第三个文件框.
------------------------------------------------------
就是这个问题。找文本框比较简单:

http://blog.csdn.net/northwolves/archive/2004/10/24/149862.aspx
northwolves 2004-10-31
  • 打赏
  • 举报
回复
to 51365133(渊海) :

整理了一下:
form:


Option Explicit

Private 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 Function

Private 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 Function

bas:
Option Explicit



Private 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 Long

Public 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 = 256

Public Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type

Public Const APP_TITLE As String = "MY EXE" '窗口标题'

Global g_frmMain As Form1

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 Function

Private 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

Sub main()
Set g_frmMain = New Form1
Load g_frmMain
g_frmMain.Show
End Sub

没看明白。
northwolves 2004-10-31
  • 打赏
  • 举报
回复
to wwqna(york):

spy++ 可以清楚的看到每一个控件ID值,然后你再根据ID值。。。
--------------------------------------------------------
不可能。烂机子无光驱,无软驱,无USB接口,只有一个带帮助的VB5。
wumylove1234 2004-10-31
  • 打赏
  • 举报
回复
楼上高手,Mark一下,明天学习一下!
51365133 2004-10-31
  • 打赏
  • 举报
回复
这是我这的一个例子的代码,可以的
51365133 2004-10-31
  • 打赏
  • 举报
回复
Option Explicit

Private 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 Long

Public 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 = 256

Public 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 Function

Private 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 Explicit

Private 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 Function

Private 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 Function



Option Explicit

Public Const APP_TITLE As String = "MY EXE" '窗口标题'

Global g_frmMain As Form1

Sub main()
Set g_frmMain = New Form1
Load g_frmMain
g_frmMain.Show
End Sub
wwqna 2004-10-31
  • 打赏
  • 举报
回复
spy++ 可以清楚的看到每一个控件ID值,然后你再根据ID值,用GetDlgItem得到文本框的hwnd,得到句柄估计狼兄可以轻易的搞定了吧。
tztz520 2004-10-31
  • 打赏
  • 举报
回复
可以找到文本框,但就是不知道怎么分辨出哪个是第三个文件框.
yjb136 2004-10-31
  • 打赏
  • 举报
回复
楼主你说的是DELPHI还是VB呀,

可果是delphi可以到DELphi我想那儿人比较多的
goodname008 2004-10-31
  • 打赏
  • 举报
回复
文本框可以处理以下消息:

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
goodname008 2004-10-31
  • 打赏
  • 举报
回复
先把主窗口设置为当前窗口,然后再设置文本框为焦点。

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧