Перехват вывода консольного окна, запущенного другой программой - VB

Option Explicit
 
Private Type SMALL_RECT
    Left As Integer
    Top As Integer
    Right As Integer
    Bottom As Integer
End Type
Private Type CONSOLE_SCREEN_BUFFER_INFO
    dwSize As Long
    dwCursorPosition As Long
    wAttributes As Integer
    srWindow As SMALL_RECT
    dwMaximumWindowSize As Long
End Type
 
Private Declare Function GetConsoleScreenBufferInfo Lib "kernel32" (ByVal hConsoleOutput As Long, lpConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO) As Long
Private Declare Function RegisterShellHookWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function DeregisterShellHookWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageW" (ByVal lpString As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hwnd As Long, ByVal nIndex 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 Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExW" (lpVersionInformation As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function QueryFullProcessImageName Lib "kernel32" Alias "QueryFullProcessImageNameW" (ByVal hProcess As Long, ByVal dwFlags As Long, ByVal lpExeName As Long, lpdwSize As Long) As Long
Private Declare Function AttachConsole Lib "kernel32" (ByVal ProcessID As Long) As Boolean
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function ReadConsoleOutputCharacter Lib "kernel32" Alias "ReadConsoleOutputCharacterW" (ByVal hConsoleOutput As Long, ByVal lpCharacter As Long, ByVal nLength As Long, ByVal dwReadCoord As Long, lpNumberOfCharsRead As Long) As Long
Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long
 
Private Const GWL_WNDPROC                       As Long = (-4)
Private Const GWL_USERDATA                      As Long = (-21)
Private Const HSHELL_WINDOWCREATED              As Long = &H1
Private Const PROCESS_QUERY_LIMITED_INFORMATION As Long = &H1000
Private Const PROCESS_QUERY_INFORMATION         As Long = &H400
Private Const INVALID_HANDLE_VALUE              As Long = -1
Private Const MAX_PATH                          As Long = 260
Private Const STD_OUTPUT_HANDLE                 As Long = -11&
 
Dim ShellMsg        As Long
Dim verInit         As Boolean
Dim IsVistaAndLater As Boolean
Dim ConsolePath     As String
Dim hOut            As Long
Dim isAttached      As Boolean
 
' Path - ГЇГіГІГј äî ГЄГ®Г*ñîëè
Public Sub Hook(ByVal hwnd As Long, Path As String)
    Dim prev As Long, inf(68) As Long
    ConsolePath = Path
    inf(0) = 276: GetVersionEx inf(0): IsVistaAndLater = inf(1) >= 6
    RegisterShellHookWindow hwnd
    ShellMsg = RegisterWindowMessage(StrPtr("SHELLHOOK"))
    prev = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc)
    SetWindowLong hwnd, GWL_USERDATA, prev
End Sub
Public Sub Unhook(ByVal hwnd As Long)
    Dim prev As Long
    prev = GetWindowLong(hwnd, GWL_USERDATA)
    If prev = 0 Then Exit Sub
    SetWindowLong hwnd, GWL_WNDPROC, prev
    SetWindowLong hwnd, GWL_USERDATA, 0
End Sub
' Ïîëó÷èòü ГІГҐГЄГ±ГІ ГЄГ®Г*ñîëè
Public Function GetConsoleText() As String
    Dim infBuf  As CONSOLE_SCREEN_BUFFER_INFO
    Dim count   As Long
    Dim buf     As String
    Dim i       As Long
    If Not isAttached Then Exit Function
    GetConsoleScreenBufferInfo hOut, infBuf
    count = infBuf.dwSize And &HFFFF&
    buf = Space(count)
    For i = 0 To (infBuf.dwSize \ &H10000) And &HFFFF&
        ReadConsoleOutputCharacter hOut, StrPtr(buf), count, i * &H10000, count
        GetConsoleText = GetConsoleText & buf & vbNewLine
    Next
End Function
' Îñâîáîäèòü ГЄГ®Г*ñîëü
Public Sub ReleaseConsole()
    FreeConsole
    isAttached = False
End Sub
Private Function WndProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim prev As Long
    Select Case msg
    Case ShellMsg
        If wParam = HSHELL_WINDOWCREATED Then
            ' ÑîçäГ*ëîñü îêГ*Г®
            Dim pid     As Long
            Dim hProc   As Long
            ' Ïîëó÷Г*ГҐГ¬ pid
            GetWindowThreadProcessId lParam, pid
            hProc = OpenProcess(IIf(IsVistaAndLater, PROCESS_QUERY_LIMITED_INFORMATION, PROCESS_QUERY_INFORMATION), False, pid)
            If hProc <> INVALID_HANDLE_VALUE Then
                Dim Path As String
                Dim lStr As Long
                ' Ïîëó÷Г*ГҐГ¬ èìÿ ïðîöåññГ*
                lStr = MAX_PATH
                Path = Space(lStr)
                If QueryFullProcessImageName(hProc, 0, StrPtr(Path), lStr) Then
                    If StrComp(ConsolePath, Left$(Path, lStr), vbTextCompare) = 0 Then
                        ' ГЌГ*øëè Г*Г*ГёГҐ îêГ*Г®
                        AttachConsole pid
                        hOut = GetStdHandle(STD_OUTPUT_HANDLE)
                        Unhook hwnd
                        isAttached = True
                    End If
                End If
                CloseHandle hProc
            End If
        End If
    Case Else
        prev = GetWindowLong(hwnd, GWL_USERDATA)
        WndProc = CallWindowProc(prev, hwnd, msg, wParam, lParam)
    End Select
End Function