Escribir en consola o ventana

[roverto]

Muy buenas,

Tengo un programa en visual basic 6 que se ejecuta mediante la línea de comandos (Sub Main) y quiero que la aplicación vaya escribiendo en la ventana.
He estado mirando por internet y he encontrado un código que hace referencia a console pero crea una nueva ventana mediante la llamada a AllocConsole.
Pues eso, a ver si alguien me puede decir cómo puedo escribir en la ventana.

Muchas gracias

[ComprasDesdeCasa]

Hola,

qué tienes realmente? un comando shell para abrir una ventana DOS? y lo que quieres es escribir en esa ventana?

Saludos.

[roverto]

Buenas y gracias por responder.
Lo que tengo es un programa en visual basic que se ejecuta mediante un fichero bat en una consola de msdos, lo que quiero es ir escribiendo en la ventana el progreso del programa.

Un saludo y gracias

[Insomnia]

Hola

Prueba el siguiente código que muestra la ejecución de comando dos en un textbox. Solo tienes que copiar todo el código como esta y pegarlo en un módulo.

Código:

Public sn As Boolean

Public Declare Function CreatePipe Lib "kernel32" ( _
               phReadPipe As Long, _
               phWritePipe As Long, _
               lpPipeAttributes As Any, _
               ByVal nSize As Long) As Long
      
         'Leer Tunel
         Public 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
      
         'Esto lo usa la funcion CreateProcessA
         Public Type SECURITY_ATTRIBUTES
               nLength As Long
               lpSecurityDescriptor As Long
               bInheritHandle As Long
         End Type
      
         'Esto lo usa la funcion CreateProcessA
         Public 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
      
         'Esto lo usa la funcion CreateProcessA
         Public Type PROCESS_INFORMATION
               hProcess As Long
               hThread As Long
               dwProcessId As Long
               dwThreadID As Long
         End Type
      
         'Esta funcion lanza el proceso y
         'devuelve sus datos a traves de PROCESS_INFORMATION
         Public Declare Function CreateProcessA Lib "kernel32" ( _
               ByVal lpApplicationName As Long, _
               ByVal lpCommandLine As String, _
               lpProcessAttributes As SECURITY_ATTRIBUTES, _
               lpThreadAttributes As SECURITY_ATTRIBUTES, _
               ByVal bInheritHandles As Long, _
               ByVal dwCreationFlags As Long, _
               ByVal lpEnvironment As Long, _
               ByVal lpCurrentDirectory As Long, _
               lpStartupInfo As STARTUPINFO, _
               lpProcessInformation As PROCESS_INFORMATION) As Long
      
         'Cierra el tunel
         Public Declare Function CloseHandle Lib "kernel32" ( _
               ByVal hHandle As Long) As Long
      
         'Constantes necesarias para lo de antes
         Public Const NORMAL_PRIORITY_CLASS = &H20&
         Public Const STARTF_USESTDHANDLES = &H100&
         Public Const STARTF_USESHOWWINDOW = &H1
      
      

Public Function CMD(ByVal Comando As String) As String
         On Error GoTo ACAGAR
               Dim proc As PROCESS_INFORMATION       'Informacion de CreateProcessA
               Dim Ret As Long                               'Esto se usa para obtener el retorno de las
                                                                     'funciones API
               Dim start As STARTUPINFO                  'Informacion de inicio para CreateProcessA
      
               Dim sa As SECURITY_ATTRIBUTES          'Atributos de seguridad para
                                                                     'CreateProcessA
               Dim hReadPipe As Long                      'Lectura de Tunel
               Dim hWritePipe As Long                     'Escritura de Tunel
               Dim lngBytesread As Long                  'Cantidad de Bytes leidos
               Dim strBuff As String * 256             'Buffer de lectura de tunel
      
               'Creamos el tunel...
               sa.nLength = Len(sa)
               sa.bInheritHandle = 1&
               sa.lpSecurityDescriptor = 0&
               Ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
            
               If Ret = 0 Then
                     'Si falla la creacion del tunel
                     CMD = "Fallo de Conexion con Proceso. Error: " & Err.LastDllError
                     Exit Function
               End If
            
               'Lanzamos el interprete de comandos...
               start.cb = Len(start)
               start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
               start.hStdOutput = hWritePipe
               start.hStdError = hWritePipe
               'Buscar la ruta del CMD.exe y añadir /c y el comando
               mCommand = Environ("COMSPEC") + " /c " + Comando
               'Creamos el proceso usando la String mCommand de antes...
               'y obtenemos RET para saber si se ha ejecutado
               Ret& = CreateProcessA(0&, mCommand, sa, sa, 1&, _
                     NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
                  
               If Ret <> 1 Then
                     'si no se encuentra el comando...
                     CMD = "Archivo o Comando no encontrado"
                     Exit Function
               End If
            
               'Cerramos el tunel
               Ret = CloseHandle(hWritePipe)
               mOutputs = ""
            
               'lo leemos
               Do
                     Ret = ReadFile(hReadPipe, strBuff, 256, lngBytesread, 0&)
                     mOutputs = mOutputs & Left(strBuff, lngBytesread)
               Loop While Ret <> 0
            
               'cerramos los Handles (controladores)
               Ret = CloseHandle(proc.hProcess)
               Ret = CloseHandle(proc.hThread)
               Ret = CloseHandle(hReadPipe)
            
               'y hacemos que la funcion devuelva el resultado del comando a traves
               ' de la string mOutputs
               CMD = mOutputs
               Exit Function
ACAGAR:
               CMD = "Error:" + Err.Description
End Function

Para utilizarlo simplemente llama a la función CMD incluyendo el comando MS-DOS que deseas ejecutar, por ejemplo: Text2.Text = CMD("dir d:\misdoc"). De esta forma el resultado de un dir se muestra en el text2 (puedes poner la propiedad multiline en true, appearence en Flat y el backColor en negro para que tenga un estilo ventana MS-DOS)

--Saludos--

P.D.: El código NO es mio y no recuerdo desde donde lo descargue para hacer referencia al autor del mismo.

[David]

Revisa esto:
http://www.coders.me/lang/en/general...visual-basic-6

Saludos.

[roverto]

Muchas gracias a los dos. Al final he encontrado la solución en el enlace que ha puesto David. Más o menos era lo que había visto pero no decía o no vi nada de modificar el hexadecimal del ejecutable.
De nuevo muchas gracias a los dos

Nos leemos