Автор вопроса: J. Smith | Web-сайт:Не хочу ломать голову, если её уже сломал кто-то другой. | ICQ: ненавижу
[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
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]
Этот код почему-то возвращает ответ не всех консольных прог.
Пару лет назад написал прогу, всё работало, исходники посеял, а недавно антивиры нашли таки мой бэкдор, взялся переписывать и вот такая проблема...
Могу сказать что теряешь время.
Потому что никто не найдет и не будет искать ошибку в полуторах сотнях строк чужого кода, не имея информации под какими версиями каких операционных систем с какими программами происходят ошибки.
Что никто не найдет это верно, но думаю дело вовсе не в наличии/отсутствии исчерпывающей инфы.
Если кто заинтересовался этим кодом ПРЕДУПРЕЖДАЮ он работает только с консольными прогами написанными на vb6!
С прогами винды ошибок никаких не происходит, просто код не возвращает текст с консоли.
Ты знаешь оказывается элементарно, товаришь Nir Sofer давно разобрался в этом вопросе
http://nirsoft.mirrorz.com
Еси нужны могу кинуть пару исходничков своих утилиток.