'Вот, что я написал:
'На форме должны располагаться:
'1) Таймер tmrTimer (интервал ~25-50)
'2) RTB RichTextBox1
'Все события происходят по таймеру...
'Если в момент "тика" нажата левая кнопка мыши и окно, на которое
'направлен курсор имеет класс окна RichTextBox, то текст из этого
'окна должен скопироваться в ваш RichTextBox1.
'На практике есть одна проблема: (см. по тексту)
'API DECLARATIONS
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint 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 Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
'Type for window identification
Private Type POINTAPI
X As Long
Y As Long
End Type
'Constant for left mouse button
Private Const VK_LBUTTON = &H1
'Maximum sizes of window text & class name
Private Const MAX_TEXT_SIZE = 1024
Private Const MAX_CLASS_NAME_SIZE = 32
'Used variables
Private cPos As POINTAPI
Private wHwnd As Long
Private wTextLen As Long
Private wClassLen As Long
Private wText As String * MAX_TEXT_SIZE
Private wClass As String * MAX_CLASS_NAME_SIZE
'Строка с необходимым классом
Private wNeedClass As String * MAX_CLASS_NAME_SIZE
'Временная переменная
Private Data As String
Private Sub Form_Load()
'Заполнение пробелами
wText = Space(MAX_TEXT_SIZE)
wClass = Space(MAX_CLASS_NAME_SIZE)
wNeedClass = Space(MAX_CLASS_NAME_SIZE)
'Имя класса окна RTB
wNeedClass = "RichTextWndClass"
End Sub
Private Sub tmrTimer_Timer()
'Если не нажата мышь, то выходим...
If GetAsyncKeyState(VK_LBUTTON) >= 0 Then Exit Sub
'Ищем hwnd текущего окна под курсором...
GetCursorPos cPos
wHwnd = WindowFromPoint(cPos.X, cPos.Y)
'Ищем класс окна под курсором...
GetClassName wHwnd, wClass, MAX_CLASS_NAME_SIZE
'Ищем длину текста окна...
wTextLen = GetWindowTextLength(wHwnd)
'Ошибка в этой строке: одинаковые строки не равны (???)
If Trim$(wClass) = Trim$(wNeedClass) Then
GetWindowText wHwnd, wText, MAX_TEXT_SIZE
wText = Trim$(wText)
If MsgBox("Переместить текст из этого элемента в RichTextBox1?", vbYesNo) = vbYes Then
Data = Trim$(wText)
RichTextBox1.Text = Data
End If
End If
End Sub
'Вот и всё, в общем-то... Если не проверять классы, а тыкать точно в окно, то всё ОК, но что-то у меня в коде. наверное, неверно... Вроде, если выводить имена классов через messagebox, то всё одинаково... Я ничего пока не понял
А так, пример вполне работоспособен. Скопируйте этот текст программы в одно окно VB, создайте ещё один проект с RTB, введите туда что-нибудь и попробуйте хакнуть... У меня при отключении проверки имён классов всё работало. Удачи!