Мониторинг консольной программы - VB
Формулировка задачи:
Есть консольное приложение которое постоянно что-то выводит на экран
Как считать все содержимое окна в литерную переменную ?
Решение задачи: «Мониторинг консольной программы»
textual
Листинг программы
- Option Explicit
- Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
- Private Declare Function PeekNamedPipe Lib "kernel32" (ByVal hNamedPipe As Long, lpBuffer As Any, ByVal nBufferSize As Long, lpBytesRead As Long, lpTotalBytesAvail As Long, lpBytesLeftThisMessage As Any) As Long
- Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
- Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
- Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
- Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
- Private Type SECURITY_ATTRIBUTES
- nLength As Long
- lpSecurityDescriptor As Long
- bInheritHandle As Long
- End Type
- Private Type PROCESS_INFORMATION
- hProcess As Long
- hThread As Long
- dwProcessId As Long
- dwThreadId As Long
- End Type
- Private Type STARTUPINFO
- cb As Long
- lpReserved As Long
- lpDesktop As Long
- lpTitle As Long
- dwX As Long
- dwY As Long
- dwXSize As Long
- dwYSize As Long
- dwXCountChars As Long
- dwYCountChars As Long
- dwFillAttribute As Long
- dwFlags As Long
- wShowWindow As Integer
- cbReserved2 As Integer
- lpReserved2 As Byte
- hStdInput As Long
- hStdOutput As Long
- hStdError As Long
- End Type
- Private Const STARTF_USESHOWWINDOW = &H1
- Private Const STARTF_USESTDHANDLES = &H100
- Private Const SW_HIDE = 0
- Private Const EM_SETSEL = &HB1
- Private Const EM_REPLACESEL = &HC2
- Dim hRead As Long, hWrite As Long, info As PROCESS_INFORMATION
- Private Function Read() As String
- Dim buf As String, count As Long, tmp As Byte
- Do
- PeekNamedPipe hRead, tmp, 1, count, 0, ByVal 0
- If count = 0 Then Exit Do
- buf = Space(1024)
- If ReadFile(hRead, ByVal buf, 1024, count, ByVal 0&) Then
- Read = Read & Left(buf, count)
- Else
- Exit Do
- End If
- Loop
- End Function
- Private Sub InitConsole(CommandLine As String)
- Dim attr As SECURITY_ATTRIBUTES
- Dim sui As STARTUPINFO
- attr.nLength = Len(attr)
- attr.lpSecurityDescriptor = 0
- attr.bInheritHandle = True
- If CreatePipe(hRead, hWrite, attr, 0) <> 0 Then
- sui.cb = Len(sui)
- GetStartupInfo sui
- sui.hStdOutput = hWrite
- sui.hStdError = hWrite
- sui.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
- sui.wShowWindow = SW_HIDE
- If CreateProcess(vbNullString, CommandLine, ByVal 0, ByVal 0, True, 0, ByVal 0, vbNullString, sui, info) = 0 Then
- CloseHandle hRead: CloseHandle hWrite
- MsgBox "error": End
- End If
- End If
- End Sub
- Private Sub DeinitConsole()
- CloseHandle hRead: CloseHandle hWrite: CloseHandle info.hThread: CloseHandle info.hProcess
- End Sub
- Private Sub cmdRead_Click()
- txtConsole.Text = Read
- End Sub
- Private Sub Form_Load()
- InitConsole "C:\Windows\System32\Cmd.exe"
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- DeinitConsole
- End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д