Хук на функцию TextOutW - получение текста метки другого приложения

$UniqueName = "My Hook"
#Compile Dll "HookD.Dll"
#Register None
#Dim All
#Include "Win32Api.Inc"
 
Global  hCallBackProc As Long
Global hInstDLL As Long, MainDll As Long
 
Declare Function VB_Function( txt As String) As Long
Declare Function GetHw(ByVal txt As String) As Long
 
Function SetHookProc(Op As Long) As Long
    Static hProc As Long, tProc As String
    Local hLib As Long
    If hProc = 0 Then
    hLib = GetModuleHandle("gdi32.dll")
    hProc = GetProcAddress(hLib, "TextOutW")
    tProc = Peek$(hProc, 7)
    If IsFalse(VirtualProtect (ByVal hProc, 7, ByVal %PAGE_EXECUTE_READWRITE, ByRef hLib)) Then _
    MsgBox "Error in VirtualProtect": hProc = 0: Exit Function
    End If
    If Op = 1 Then Poke$ hProc, Chr$(&HB8) + Mkl$(CodePtr(MyTextOut)) + Chr$(&HFF, &HE0)
    If Op = 2 Then Poke$ hProc, tProc
    FlushInstructionCache GetCurrentProcess, ByVal hProc, ByVal 7
End Function
 
 
Function MyTextOut (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As Dword, ByVal nCount As Long) As Long
    Local MyString As String
    Static GetStr As String
    If lpString Then MyString = Peek$(lpString, nCount)
    SetHookProc 2
    MyString=Space$(nCount*2)
    MyString= Peek$(lpString, nCount*2)
    MyString=ACode$(MyString)
    Local gui As GUITHREADINFO
    Local R As Long
    gui.cbSize = SizeOf(GUITHREADINFO)
    GetGUIThreadInfo ThreadID, gui To r
    Local hProcess         As Long
    hProcess = FindWindow("TForm1", ByCopy "Form1")
    If hProcess=GUI.hwndActive And hProcess<>0  Then
           hProcess = FindWindow("", ByCopy "MY HOOK")
           hProcess = FindWindowEx(hProcess,0,"ThunderRT6TextBox","")
           GetStr=GetStr+MyString
           SendMessage hProcess, %WM_SETTEXT, 0, StrPtr(GetStr)
           hProcess=0
    End If
    TextOut hdc, x, y, ByVal StrPtr(MyString), Len(MyString)
    SetHookProc 1
End Function
 
 
Function LibMain(ByVal hInstance As Long, ByVal fwdReason As Long, ByVal lpvReserved As Long) Export As Long
    Select Case fwdReason
        Case %DLL_PROCESS_ATTACH: hInstDLL = hInstance: LibMain = 1: SetHookProc 1
        Case %DLL_PROCESS_DETACH: LibMain = 1: SetHookProc 2
    End Select
End Function
 
Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) Export As Long
    Static hHook As Long, hDlg As Long
    hDlg = FindWindow("", $UniqueName)
    If hHook = 0 Then If hDlg Then hHook = GetProp(hDlg, ByVal 1)
    If hHook Then Function = CallNextHookEx(ByVal hHook, ByVal nCode, ByVal wParam, ByVal lParam)
    If IsFalse(MainDll) And (IsFalse(hDlg) Or IsFalse(hHook)) Then FreeLibrary hInstDll
End Function
 
 
Function SetHook Alias "SetHook" ( hWnd As Long) Export As Long
    Local hHook As Long
    hHook = SetWindowsHookEx (%WH_CBT, CodePtr(HookProc), ByVal hInstDLL, ByVal 0)
    SetProp hWnd, ByVal 1, ByVal hHook
    MainDll = 1
End Function