Перехват вывода консольного окна, запущенного другой программой - VB
Формулировка задачи:
Привет всем барсикам и заглянувшим в тему !
Есть программа, которая создает консольное окно, выполняет в нем команды и сразу закрывает это окно.
Как прочитать весь текст из такого окна.
Допустим, я отслежу таймером изменение хендла по GetForegroundWindow, найдя окно консоли.
А как дальше?
Чем считать текст?
Структура STARTUPINFO еще имеет влияние на поведение процесса, если внести в нее модификации уже после запуска процесса?
Решение задачи: «Перехват вывода консольного окна, запущенного другой программой»
textual
Листинг программы
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