要先获取对话框句柄An application sends a WM_SETTEXT message to set the text of a window. To send this message, call the SendMessage function as follows. lResult = SendMessage( // returns LRESULT in lResult (HWND) hWndControl, // handle to destination control (UINT) WM_SETTEXT, // message ID (WPARAM) wParam, // = (WPARAM) () wParam; (LPARAM) lParam // = (LPARAM) () lParam; );
还是用实际例子来说明: 新建工程,在窗体上放置一个listbox,一个combobox两个按钮 粘贴如下代码,它会得到当前活动窗口的一些文本信息,句柄等Private Const GUI_CARETBLINKING As Long = &H1 Private Const GUI_INMOVESIZE As Long = &H2 Private Const GUI_INMENUMODE As Long = &H4 Private Const GUI_SYSTEMMENUMODE As Long = &H8 Private Const GUI_POPUPMENUMODE As Long = &H10 Private Const GUI_16BITTASK As Long = &H20 'winver >= 5.01 Private Const LB_SETTABSTOPS As Long = &H192 Private Const WM_GETTEXT As Long = &HD Private Const WM_GETTEXTLENGTH As Long = &HEPrivate Type RECT Left As Long Top As Long Right As Long Bottom As Long End TypePrivate Type GUITHREADINFO cbSize As Long flags As Long hwndactive As Long hwndFocus As Long hwndCapture As Long hwndMenuOwner As Long hwndMoveSize As Long hwndcaret As Long rcCaret As RECT End TypePrivate Declare Function GetGuiThreadInfo Lib "user32" _ Alias "GetGUIThreadInfo" (ByVal idThread As _ Long, lpgui As GUITHREADINFO) As LongPrivate Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As LongPrivate Declare Function GetWindowTextLength Lib "user32" _ Alias "GetWindowTextLengthA" _ (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" _ Alias "GetWindowTextA" _ (ByVal hwnd As Long, _ ByVal lpString As String, _ ByVal cch As Long) As LongPrivate Sub Form_Load() 'set up list tabstops ReDim TabArray(0 To 0) As Long
End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Timer1.Enabled = False
End Sub Private Sub Combo1_Click() 'if timer running, this will 'change its update frequency Timer1.Interval = Combo1.ItemData(Combo1.ListIndex)End Sub Private Sub Command1_Click() Timer1.Interval = Combo1.ItemData(Combo1.ListIndex) Timer1.Enabled = True
End SubPrivate Sub Command2_Click() Unload Me
End Sub Private Sub Timer1_Timer() 'nuke the list if 250 or more entries If List1.ListCount > 250 Then List1.Clear
'update with info from the active window Call GetActiveWindowGuiInfo
End Sub Private Sub GetActiveWindowGuiInfo() Dim gui As GUITHREADINFO Static numcalls As Long
'idThread identifies the thread for which 'information is to be retrieved. Where the 'purpose is to monitor a specific form or 'application, GetWindowThreadProcessId() 'provides the thread ID required. ' 'Conveniently for this demo, when idThread 'is null, GetGUIThreadInfo returns information 'for the foreground thread, thus allowing 'us to move between applications and view 'the activities therein.
'cbSize must be set before calling gui.cbSize = Len(gui) If GetGuiThreadInfo(0&, gui) <> 0 Then
'numcalls is just a counter to increment 'a line in the list to show the code is 'working when you rest in one window numcalls = numcalls + 1
'AND the flags to return the 'possible GUI states .AddItem "returned flags:" & vbTab & gui.flags
If gui.flags And GUI_CARETBLINKING Then .AddItem "caret is visible" If gui.flags And GUI_INMOVESIZE Then .AddItem "thread is in a move or size loop" If gui.flags And GUI_INMENUMODE Then .AddItem "thread is in menu mode" If gui.flags And GUI_SYSTEMMENUMODE Then .AddItem "thread is in system menu mode" If gui.flags And GUI_POPUPMENUMODE Then .AddItem "thread has active popup menu" If gui.flags And GUI_16BITTASK Then .AddItem "thread's app is 16-bits"
'add a blank line and ensure the 'last-added entry is in view .AddItem "" .TopIndex = .NewIndex
End With 'with list1 Else
With List1 .AddItem "Error " & Err.LastDllError .AddItem "Error " & Err.Description .AddItem "" .TopIndex = .NewIndex End With 'with list1
End If
End Sub Private Function GetActiveWindowTitle(ByVal hwndactive As Long) As String Dim nLength As Long Dim res As Long Dim buff As String
'GetWindowText returns the title 'of the window specified as hwndactive If hwndactive <> 0 Then
nLength = GetWindowTextLength(hwndactive)
If nLength <> 0 Then
buff = Space$(nLength + 1)
res = GetWindowText(hwndactive, buff, nLength + 1)
If res <> 0 Then GetActiveWindowTitle = Left$(buff, res) Exit Function End If 'if res
End If 'if nlength
End If 'if hwndactive
GetActiveWindowTitle = "(not available)"
End Function Private Function GetCaretWindowText(ByVal hwndcaret As Long) As String Dim nLength As Long Dim res As Long Dim buff As String
'WM_GETTEXT retrieves the text 'from edit and rich text controls If hwndcaret <> 0 Then
lResult = SendMessage( // returns LRESULT in lResult (HWND) hWndControl, // handle to destination control (UINT) WM_SETTEXT, // message ID (WPARAM) wParam, // = (WPARAM) () wParam; (LPARAM) lParam // = (LPARAM) () lParam; );
其次在考虑利用钩子来改变内存中的数据
(利用钩子可以实现)
新建工程,在窗体上放置一个listbox,一个combobox两个按钮
粘贴如下代码,它会得到当前活动窗口的一些文本信息,句柄等Private Const GUI_CARETBLINKING As Long = &H1
Private Const GUI_INMOVESIZE As Long = &H2
Private Const GUI_INMENUMODE As Long = &H4
Private Const GUI_SYSTEMMENUMODE As Long = &H8
Private Const GUI_POPUPMENUMODE As Long = &H10
Private Const GUI_16BITTASK As Long = &H20 'winver >= 5.01
Private Const LB_SETTABSTOPS As Long = &H192
Private Const WM_GETTEXT As Long = &HD
Private Const WM_GETTEXTLENGTH As Long = &HEPrivate Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypePrivate Type GUITHREADINFO
cbSize As Long
flags As Long
hwndactive As Long
hwndFocus As Long
hwndCapture As Long
hwndMenuOwner As Long
hwndMoveSize As Long
hwndcaret As Long
rcCaret As RECT
End TypePrivate Declare Function GetGuiThreadInfo Lib "user32" _
Alias "GetGUIThreadInfo" (ByVal idThread As _
Long, lpgui As GUITHREADINFO) As LongPrivate Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As LongPrivate Declare Function GetWindowTextLength Lib "user32" _
Alias "GetWindowTextLengthA" _
(ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As LongPrivate Sub Form_Load() 'set up list tabstops
ReDim TabArray(0 To 0) As Long
TabArray(0) = 107
Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 1&, TabArray(0))
'set up timer intervals
With Combo1
.AddItem "100 milliseconds"
.ItemData(.NewIndex) = 100
.AddItem "1/2 second"
.ItemData(.NewIndex) = 500
.AddItem "1 second"
.ItemData(.NewIndex) = 1000
.AddItem "2 seconds"
.ItemData(.NewIndex) = 2000
.AddItem "3 seconds"
.ItemData(.NewIndex) = 3000
.AddItem "5 seconds"
.ItemData(.NewIndex) = 5000
.ListIndex = 2 '1 second
End With Command1.Caption = "Start"
Command2.Caption = "Done"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Timer1.Enabled = False
End Sub
Private Sub Combo1_Click() 'if timer running, this will
'change its update frequency
Timer1.Interval = Combo1.ItemData(Combo1.ListIndex)End Sub
Private Sub Command1_Click() Timer1.Interval = Combo1.ItemData(Combo1.ListIndex)
Timer1.Enabled = True
End SubPrivate Sub Command2_Click() Unload Me
End Sub
Private Sub Timer1_Timer() 'nuke the list if 250 or more entries
If List1.ListCount > 250 Then List1.Clear
'update with info from the active window
Call GetActiveWindowGuiInfo
End Sub
Private Sub GetActiveWindowGuiInfo() Dim gui As GUITHREADINFO
Static numcalls As Long
'idThread identifies the thread for which
'information is to be retrieved. Where the
'purpose is to monitor a specific form or
'application, GetWindowThreadProcessId()
'provides the thread ID required.
'
'Conveniently for this demo, when idThread
'is null, GetGUIThreadInfo returns information
'for the foreground thread, thus allowing
'us to move between applications and view
'the activities therein.
'cbSize must be set before calling
gui.cbSize = Len(gui) If GetGuiThreadInfo(0&, gui) <> 0 Then
'numcalls is just a counter to increment
'a line in the list to show the code is
'working when you rest in one window
numcalls = numcalls + 1
With List1
.AddItem CStr(numcalls)
.AddItem "active window hwnd:" & vbTab & gui.hwndactive
.AddItem " active window title:" & vbTab & GetActiveWindowTitle(gui.hwndactive)
.AddItem "mouse capture hwnd:" & vbTab & gui.hwndCapture
.AddItem "showing caret hwnd:" & vbTab & gui.hwndcaret
.AddItem " caret window text:" & vbTab & GetCaretWindowText(gui.hwndcaret)
.AddItem "keyboard focus hwnd:" & vbTab & gui.hwndFocus
.AddItem "active menu owner hwnd:" & vbTab & gui.hwndMenuOwner
.AddItem "move or size loop hwnd:" & vbTab & gui.hwndMoveSize
.AddItem "caret rect (l/r t/b):" & vbTab & _
gui.rcCaret.Left & "/" & _
gui.rcCaret.Right & " " & _
gui.rcCaret.Top & "/" & _
gui.rcCaret.Bottom
'AND the flags to return the
'possible GUI states
.AddItem "returned flags:" & vbTab & gui.flags
If gui.flags And GUI_CARETBLINKING Then .AddItem "caret is visible"
If gui.flags And GUI_INMOVESIZE Then .AddItem "thread is in a move or size loop"
If gui.flags And GUI_INMENUMODE Then .AddItem "thread is in menu mode"
If gui.flags And GUI_SYSTEMMENUMODE Then .AddItem "thread is in system menu mode"
If gui.flags And GUI_POPUPMENUMODE Then .AddItem "thread has active popup menu"
If gui.flags And GUI_16BITTASK Then .AddItem "thread's app is 16-bits"
'add a blank line and ensure the
'last-added entry is in view
.AddItem ""
.TopIndex = .NewIndex
End With 'with list1 Else
With List1
.AddItem "Error " & Err.LastDllError
.AddItem "Error " & Err.Description
.AddItem ""
.TopIndex = .NewIndex
End With 'with list1
End If
End Sub
Private Function GetActiveWindowTitle(ByVal hwndactive As Long) As String Dim nLength As Long
Dim res As Long
Dim buff As String
'GetWindowText returns the title
'of the window specified as hwndactive
If hwndactive <> 0 Then
nLength = GetWindowTextLength(hwndactive)
If nLength <> 0 Then
buff = Space$(nLength + 1)
res = GetWindowText(hwndactive, buff, nLength + 1)
If res <> 0 Then
GetActiveWindowTitle = Left$(buff, res)
Exit Function
End If 'if res
End If 'if nlength
End If 'if hwndactive
GetActiveWindowTitle = "(not available)"
End Function
Private Function GetCaretWindowText(ByVal hwndcaret As Long) As String Dim nLength As Long
Dim res As Long
Dim buff As String
'WM_GETTEXT retrieves the text
'from edit and rich text controls
If hwndcaret <> 0 Then
nLength = SendMessage(hwndcaret, WM_GETTEXTLENGTH, 0&, ByVal 0&)
If nLength <> 0 Then
buff = Space$(nLength + 1)
res = SendMessage(hwndcaret, WM_GETTEXT, nLength + 1, ByVal buff)
If res <> 0 Then
GetCaretWindowText = Left$(buff, res)
Exit Function
End If 'if res
End If 'if nlength
End If 'if hwndcaret
GetCaretWindowText = "(not available)"
End Function
'--end block--'