Страница: 1 |
Вопрос: Чтение консоли VB6 | Добавлено: 18.09.09 14:07 |
Автор вопроса: ![]() |
[SOURCE]Option Explicit
Private Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As Long End Type Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle 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 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 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 CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long Private Declare Function DuplicateHandle Lib "kernel32" (ByVal hSourceProcessHandle As Long, ByVal hSourceHandle As Long, ByVal hTargetProcessHandle As Long, lpTargetHandle As Long, ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwOptions As Long) As Long Private Declare Function GetCurrentProcess Lib "kernel32" () As Long Private Declare Function PeekNamedPipe Lib "kernel32" (ByVal hNamedPipe As Long, ByVal lpBuffer As String, ByVal nBufferSize As Long, lpBytesRead As Long, lpTotalBytesAvail As Long, lpBytesLeftThisMessage As Long) As Long Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long Private Const DUPLICATE_SAME_ACCESS As Long = 2& Private Const ERROR_BROKEN_PIPE As Long = 109& Private Const ERROR_NO_DATA As Long = 232& Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000& Private Const STARTF_USESHOWWINDOW As Long = &H1 Private Const STARTF_USESTDHANDLES As Long = &H100& Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, ByVal lpSource As String, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, ByVal Arguments As Long) As Long Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long Dim hShell As Long, hOutputRead As Long Dim ShellRes As String Private Sub Form_Initialize() Call InitCommonControlsXP End Sub Private Sub Text2_KeyPress(KeyAscii As Integer) 'If KeyAscii = 13 Then KeyAscii = 0: Text2.Enabled = False: Text1.Text = DOS2ANSI(SysShell(Text2.Text, Text3.Text)): Text2.Enabled = True If KeyAscii = 13 Then KeyAscii = 0: Text2.Enabled = False: Text1.Text = SysShell(Text2.Text, Text3.Text): Text2.Enabled = True End Sub Private Sub tmrTimeOut_Timer() Kill End Sub Public Function ANSI2DOS(Src As Variant) As String Src = CStr(Src) ANSI2DOS = Space$(Len(Src)) CharToOem Src, ANSI2DOS End Function Public Function DOS2ANSI(Src As Variant) As String Src = CStr(Src) DOS2ANSI = Space$(Len(Src)) OemToChar Src, DOS2ANSI End Function Public Function SysShell(CmdLine As Variant, Optional Interval As Variant) As String Dim hOutputReadTmp As Long, hOutputWrite As Long Dim hErrorWrite As Long Dim tmpStr As String Dim sa As SECURITY_ATTRIBUTES Dim pi As PROCESS_INFORMATION Dim si As STARTUPINFO ShellRes = Empty CmdLine = CStr(CmdLine) tmrTimeOut.Interval = CInt(Interval) tmrTimeOut.Enabled = True With sa .nLength = Len(sa) ' .lpSecurityDescriptor = 0 .bInheritHandle = 1 End With If CreatePipe(hOutputReadTmp, hOutputWrite, sa, 0) = 0 Then ErrorMessage ("CreatePipe") ' Necessary in case the child application closes one of its std output handles. If DuplicateHandle(GetCurrentProcess, hOutputWrite, GetCurrentProcess, hErrorWrite, 0, 1, DUPLICATE_SAME_ACCESS) = 0 Then ErrorMessage ("DuplicateHandle") ' Otherwise, the child inherits the handles and, as a result, non-closeable handles are created. If DuplicateHandle(GetCurrentProcess, hOutputReadTmp, GetCurrentProcess, hOutputRead, 0, 0, DUPLICATE_SAME_ACCESS) = 0 Then ErrorMessage ("DupliateHandle") If CloseHandle(hOutputReadTmp) = 0 Then ErrorMessage ("CloseHandle") With si .cb = Len(si) .dwFlags = STARTF_USESTDHANDLES ' Or STARTF_USESHOWWINDOW .hStdOutput = hOutputWrite .hStdError = hErrorWrite .wShowWindow = 1 'vbNormal End With If CreateProcess(vbNullString, CmdLine, 0, 0, 1, 0, 0, vbNullString, si, pi) = 0 Then ErrorMessage ("CreateProcess") hShell = pi.hProcess If CloseHandle(pi.hThread) = 0 Then ErrorMessage ("CloseHandle") ' You need to make sure that no handles to the write end of the output pipe are maintained in this process ' or else the pipe will not close when the child process exits and the ReadFile will hang. If CloseHandle(hOutputWrite) = 0 Then ErrorMessage ("CloseHandle") If CloseHandle(hErrorWrite) = 0 Then ErrorMessage ("CloseHandle") With tmrRedirect .Enabled = True While .Enabled DoEvents Wend End With SysShell = ShellRes End Function Private Sub Kill() tmrRedirect.Enabled = False tmrTimeOut.Enabled = False TerminateProcess hShell, 0 If CloseHandle(hShell) = 0 Then ErrorMessage ("CloseHandle") If CloseHandle(hOutputRead) = 0 Then ErrorMessage ("CloseHandle") End Sub Private Sub tmrRedirect_Timer() Dim lpBuffer As String Dim tmpStr As String Dim nBytesRead As Long If PeekNamedPipe(hOutputRead, vbNullString, 0, 0, nBytesRead, 0) = 0 Then If Err.LastDllError = ERROR_BROKEN_PIPE Then ' Child has closed Kill Else ErrorMessage ("PeekNamedPipe") End If ElseIf nBytesRead > 0 Then lpBuffer = Space(nBytesRead) If ReadFile(hOutputRead, lpBuffer, Len(lpBuffer), nBytesRead, 0) = 0 Then ErrorMessage ("ReadFile") Else If nBytesRead > 0 Then lpBuffer = Replace(lpBuffer, Chr$(10), vbCrLf) ShellRes = ShellRes & lpBuffer End If End If End If End Sub Private Sub ErrorMessage(pszAPI As String) Dim szPrintBuffer As String * 512 Call FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, Err.LastDllError, 0, szPrintBuffer, Len(szPrintBuffer), 0) If Len(ShellRes) > 0 Then ShellRes = ShellRes & vbCrLf ShellRes = ShellRes & "Calling: " & pszAPI & vbCrLf & _ "Message: " & szPrintBuffer End Sub[/SOURCE] Этот код почему-то возвращает ответ не всех консольных прог. Пару лет назад написал прогу, всё работало, исходники посеял, а недавно антивиры нашли таки мой бэкдор, взялся переписывать и вот такая проблема... |
Ответы | Всего ответов: 6 |
Номер ответа: 1 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ICQ: ненавижу Вопросов: 40 Ответов: 477 |
Web-сайт: Профиль | Цитата | #1 | Добавлено: 18.09.09 14:11 |
Offtop: Не понял почему тэг не сработал
|
Номер ответа: 2 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Разработчик Вопросов: 130 Ответов: 6602 |
Профиль | Цитата | #2 | Добавлено: 18.09.09 20:47 |
Могу сказать что теряешь время.
Потому что никто не найдет и не будет искать ошибку в полуторах сотнях строк чужого кода, не имея информации под какими версиями каких операционных систем с какими программами происходят ошибки. |
Номер ответа: 3 Автор ответа: ![]() ![]() ![]() ![]() ![]() ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632 |
Профиль | Цитата | #3 | Добавлено: 19.09.09 16:36 |
Не теряю, разобрался уже. |
Номер ответа: 4 Автор ответа: ![]() ![]() ![]() ![]() ![]() ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632 |
Профиль | Цитата | #4 | Добавлено: 19.09.09 17:38 |
Что никто не найдет это верно, но думаю дело вовсе не в наличии/отсутствии исчерпывающей инфы.
Если кто заинтересовался этим кодом ПРЕДУПРЕЖДАЮ он работает только с консольными прогами написанными на vb6! С прогами винды ошибок никаких не происходит, просто код не возвращает текст с консоли. |
Номер ответа: 5 Автор ответа: ![]() ![]() ![]() ![]() Вопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | Цитата | #5 | Добавлено: 19.09.09 17:51 |
А как на VB6 писать консольные проги? |
Номер ответа: 6 Автор ответа: ![]() ![]() ![]() ![]() ![]() ICQ: adamis@list.ru Вопросов: 153 Ответов: 3632 |
Профиль | Цитата | #6 | Добавлено: 19.09.09 20:02 |
Ты знаешь оказывается элементарно, товаришь Nir Sofer давно разобрался в этом вопросе
http://nirsoft.mirrorz.com Еси нужны могу кинуть пару исходничков своих утилиток. |
Страница: 1 |
|