Autor
|
Tema: [SOLUCIONADO] CMD Pipe en Windows 7 (Leído 2,337 veces)
|
aaronduran2
|
Hola. Quería implementar un código para hacer un pipe del CMD en una pequeña aplicación, pero no funciona en Windows 7. El código es este: 'Redirects output from console program to textbox. ' 'Original bcx version of this program was made by ' dl <dl@tks.cjb.net> 'VB port was made by Jernej Simoncic <jernej@isg.si> 'Visit Jernejs site at [url]http://www2.arnes.si/~sopjsimo/[/url] ' 'Note: don't run plain DOS programs with this example 'under Windows 95,98 and ME, as the program freezes when 'execution of program is finnished. 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 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 SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam 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 Type OVERLAPPED ternal As Long ternalHigh As Long offset As Long OffsetHigh As Long hEvent 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 Sub Redirect(cmdLine As String, objTarget As Object) Dim i%, t$ Dim pa As SECURITY_ATTRIBUTES Dim pra As SECURITY_ATTRIBUTES Dim tra As SECURITY_ATTRIBUTES Dim pi As PROCESS_INFORMATION Dim sui As STARTUPINFO Dim hRead As Long Dim hWrite As Long Dim bRead As Long Dim lpBuffer(1024) As Byte pa.nLength = Len(pa) pa.lpSecurityDescriptor = 0 pa.bInheritHandle = True pra.nLength = Len(pra) tra.nLength = Len(tra) If CreatePipe(hRead, hWrite, pa, 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, cmdLine, pra, tra, True, 0, Null, vbNullString, sui, pi) <> 0 Then SetWindowText objTarget.hwnd, "" Do Erase lpBuffer() If ReadFile(hRead, lpBuffer(0), 1023, bRead, ByVal 0&) Then SendMessage objTarget.hwnd, EM_SETSEL, -1, 0 SendMessage objTarget.hwnd, EM_REPLACESEL, False, lpBuffer(0) DoEvents Else CloseHandle pi.hThread CloseHandle pi.hProcess Exit Do End If CloseHandle hWrite Loop CloseHandle hRead End If End If End Sub
¿Se podría adaptar a Windows 7? Un saludo.
|
|
« Última modificación: 4 Octubre 2010, 16:26 pm por aaronduran2 »
|
En línea
|
|
|
|
aaronduran2
|
Bueno, buscando un poco más a fondo encontré un código que funciona perfectamente: Option Explicit Private Declare Function CreatePipe Lib "kernel32.dll" (ByRef phReadPipe As Long, ByRef phWritePipe As Long, ByRef lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long Private Declare Function CreateProcess Lib "kernel32.dll" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByRef lpProcessAttributes As Long, ByRef lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByRef lpEnvironment As Any, ByVal lpCurrentDriectory As String, ByRef lpStartupInfo As STARTUPINFO, ByRef lpProcessInformation As PROCESS_INFORMATION) As Long Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long Private Declare Function ReadFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByRef lpOverlapped As Long) As Long Private Const STARTF_USESHOWWINDOW As Long = &H1 Private Const STARTF_USESTDHANDLES As Long = &H100 Private Const SW_HIDE As Long = 0 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 Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As Long End Type Public Sub ExecAndCapture(ByVal sCommandLine As String, cTextBox As TextBox, Optional ByVal sStartInFolder As String = vbNullString) Const BUFSIZE As Long = 1024 * 10 Dim hPipeRead As Long Dim hPipeWrite As Long Dim sa As SECURITY_ATTRIBUTES Dim si As STARTUPINFO Dim pi As PROCESS_INFORMATION Dim baOutput(BUFSIZE) As Byte Dim sOutput As String Dim lBytesRead As Long With sa .nLength = Len(sa) .bInheritHandle = 1 ' get inheritable pipe handles End With If CreatePipe(hPipeRead, hPipeWrite, sa, 0) = 0 Then Exit Sub End If With si .cb = Len(si) .dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES .wShowWindow = SW_HIDE ' hide the window .hStdOutput = hPipeWrite .hStdError = hPipeWrite End With If CreateProcess(vbNullString, sCommandLine, ByVal 0&, ByVal 0&, 1, 0&, ByVal 0&, sStartInFolder, si, pi) Then Call CloseHandle(hPipeWrite) Call CloseHandle(pi.hThread) hPipeWrite = 0 Do DoEvents If ReadFile(hPipeRead, baOutput(0), BUFSIZE, lBytesRead, ByVal 0&) = 0 Then Exit Do End If sOutput = Left$(StrConv(baOutput(), vbUnicode), lBytesRead) cTextBox.SelText = sOutput Loop Call CloseHandle(pi.hProcess) End If Call CloseHandle(hPipeRead) Call CloseHandle(hPipeWrite) End Sub
Se puede cerrar el tema.
|
|
|
En línea
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
Pasar más de un int con una pipe
Programación C/C++
|
ithory
|
2
|
5,818
|
15 Diciembre 2012, 13:23 pm
por ithory
|
|
|
pipe y QT!
Programación C/C++
|
febef
|
2
|
2,168
|
17 Abril 2013, 01:26 am
por febef
|
|
|
Pipe doble
GNU/Linux
|
desikoder
|
3
|
3,279
|
12 Noviembre 2013, 17:07 pm
por desikoder
|
|
|
Windows 8.1 Ayuda - SOLUCIONADO
« 1 2 »
Windows
|
Zorronde
|
15
|
9,527
|
26 Septiembre 2014, 03:27 am
por Zorronde
|
|
|
Consola por pipe crashea en windows 8 y versiones adelantadas
Programación Visual Basic
|
illuminat3d
|
9
|
4,137
|
7 Abril 2016, 19:31 pm
por Lekim
|
|