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