Ejecutar un programa y redirigir la salida estándar al programa de Visual Basic

 

Publicado: 29/Ago/98
Actualizado: 11/Feb/05 (coloreado del código)
Autor: Guillermo 'guille' Som


La intención de este programa es ejecutar un programa MS-DOS, (que no un comando como DIR, etc.), y redirigir la salida del mismo hacia VB, es decir, lo que el programa en cuestión muestre en la pantalla del MS-DOS, se mostrará en un TextBox y el programa a ejecutar se pasará en la línea de comandos.
Podemos usar, por ejemplo: MEM.exe, etc.

Veamos el código de ejemplo, modificado de un artículo de la Knowledge Base de Microsoft:
HOWTO: Create a Process for Reading and Writing to a Pipe (Q173085)
Entre las modificaciones, está la espera a que el proceso llamado (el programa que se ejecuta), termine, ya que si no termina, no tomaremos todos los datos, sobre todo si es una tarea que dure algunos segundos; en principio hice una pausa de un par de segundos, pero después, rebuscando en el código que ya tenía, (los afortunados que tienen el código del
gsBackUp también lo tienen), puse que esperara a que terminase el proceso. WaitForSingleObject es la función que se encarga de eso.

Bueno, vale ya de parrafadas, aquí tienes el código.
Para que funcione, deberás insertar un TextBox Multiline y que tenga las dos barras de desplazamiento (Scrollbars), además de un commandbuton.

Seguiré "investigando" o buscando información de cómo hacer lo contrario, ya que lo he intentado y no he dado con la tecla, es decir que un programa de Visual Basic pueda mostrar por el STDOUT lo que queramos.

Dejo parte del texto del artículo, aunque esté en inglés, para que sepas de que va el rollo este.


El código a insertar en el formulario:

'
Option Explicit
'
'
'This example illustrates a Visual Basic application starting
'another process with the purpose of redirecting that process's
'standard IO handles.
'The Visual Basic application redirects the created process's
'standard output handle to an anonymous pipe,
'then proceeds to read the output through the pipe.
'This sample just redirects STDOUT of the new process.
'
'To redirect other handles (STDIN and STDERR),
'create a pipe for each handle for which redirection is desired.
'The Visual Basic application would read from the read ends
'of the pipes for the redirected STDOUT and STDERR.
'If STDIN redirection was desired, the Visual Basic application
'would write to the write end of the appropriate pipe.
'
'An example follows:
'
'
'   'A pipe for redirection of STDOUT
'   CreatePipe(hReadPipe1, hWritePipe1, sa, 0)
'
'   'A pipe for redirection of STDERR
'   CreatePipe(hReadPipe2, hWritePipe2, sa, 0)
'
'   'A pipe for redirection of STDIN
'   CreatePipe(hReadPipe3, hWritePipe3, sa, 0)
'
'   'Preparing to start the process with redirected handles
'   start.hStdOutput = hWritePipe1
'   start.hStdError = hWritePipe2
'   start.hStdInput = hReadPipe3
'
'   'Reading output from the started process's STDOUT
'   ReadFile(hReadPipe1, mybuff1, 100, bytesread, ByVal 0&)
'
'   'Reading output from the started process's STDERR
'   ReadFile(hReadPipe2, mybuff2, 100, bytesread, ByVal 0&)
'
'   'Writing to the started process's STDIN
'   WriteFile(hWritePipe3, mybuff3, 100, byteswritten, ByVal 0&)
'

Private Declare Function CreatePipe Lib "kernel32" ( _
    phReadPipe As Long, _
    phWritePipe As Long, _
    lpPipeAttributes As Any, _
    ByVal nSize 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 Any) As Long

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 Long
    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

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
   lpApplicationName As Long, ByVal lpCommandLine As String, _
   lpProcessAttributes As Any, lpThreadAttributes As Any, _
   ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
   ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
   lpStartupInfo As Any, lpProcessInformation As Any) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" _
    (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal _
   hObject As Long) As Long

Const SW_SHOWMINNOACTIVE = 7
Const STARTF_USESHOWWINDOW = &H1
Const INFINITE = -1&
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&

Private Function ExecCmdPipe(ByVal CmdLine As String) As String
    'Ejecuta el comando indicado, espera a que termine
    'y redirige la salida hacia VB

    Dim proc As PROCESS_INFORMATION, ret As Long, bSuccess As Long
    Dim start As STARTUPINFO
    Dim sa As SECURITY_ATTRIBUTES
    Dim hReadPipe As Long, hWritePipe As Long
    Dim bytesread As Long, mybuff As String
    Dim i As Integer
    
    Dim sReturnStr As String
    
    '=== Longitud de la cadena, en teoría 64 KB,
    '   pero no en la práctica
    'mybuff = String(64 * 1024, Chr$(65))
    '
    mybuff = String(10 * 1024, Chr$(65))
    sa.nLength = Len(sa)
    sa.bInheritHandle = 1&
    sa.lpSecurityDescriptor = 0&
    ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
    If ret = 0 Then
        '===Error
        ExecCmd = "Error: CreatePipe failed. " & Err.LastDllError
        Exit Function
    End If
    start.cb = Len(start)
    start.hStdOutput = hWritePipe
    start.dwFlags = STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW
    start.wShowWindow = SW_SHOWMINNOACTIVE
    
    ' Start the shelled application:
    ret& = CreateProcessA(0&, CmdLine$, sa, sa, 1&, _
        NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
    If ret <> 1 Then
        '===Error
        sReturnStr = "Error: CreateProcess failed. " & Err.LastDllError
    End If
    
    ' Wait for the shelled application to finish:
    ret = WaitForSingleObject(proc.hProcess, INFINITE)
    
    'En el original, sólo leian 100 caracteres
    bSuccess = ReadFile(hReadPipe, mybuff, Len(mybuff), bytesread, 0&)
    If bSuccess = 1 Then
        sReturnStr = Left(mybuff, bytesread)
    Else
        '===Error
        sReturnStr = "Error: ReadFile failed. " & Err.LastDllError
    End If
    ret = CloseHandle(proc.hProcess)
    ret = CloseHandle(proc.hThread)
    ret = CloseHandle(hReadPipe)
    ret = CloseHandle(hWritePipe)
    
    ExecCmd = sReturnStr
End Function

Private Sub Command1_Click()
    Text1 = ExecCmdPipe(Command$)
End Sub

Private Sub Form_Load()
    '
    Text1 = ""
    '
    Show
    'Asigna al TextBox lo que se introduzca en la línea de comandos
    Text1 = ExecCmdPipe(Command$)
    Text1.Refresh
End Sub

ir al índice