Console Standard Output

[HaXeL]

I have written some code that opens a new console application and attempts to read the standard output to a text box. However, when my ReadFile funtion tries to get data from the standard output when there is no data left to read, program crashes and I am not sure how to see if there is nothing left to read. Also, I want the console app to be invisible, and it doesn;t seem to close the console window when I close the handle. Any help would be appreciated. Thanks

Option Explicit

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

Const NORMAL_PRIORITY_CLASS = &H20&
Const STARTF_USESTDHANDLES = &H100&
Const STARTF_USESHOWWINDOW = &H1

Const SW_HIDE = 0&
Const SW_NORMAL = 1&

Public Sub ExecCmd(cmdline As String)

Dim proc As PROCESS_INFORMATION
Dim Result As Long
Dim bSuccess As Long
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As Long
Dim hWritePipe As Long
Dim Buffer As String
Dim L As Long
Dim A As Long
Dim dummy As Integer

sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
Result = CreatePipe(hReadPipe, hWritePipe, sa, 0)

If Result = 0 Then
Err.Raise "Could not initialize the running of a console application."
Exit Sub
End If

start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES
start.hStdOutput = hWritePipe
start.wShowWindow = SW_HIDE

Result = CreateProcessA(0&, cmdline, sa, sa, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

If Result <> 1 Then
Err.Raise "Could not run GOLF program."
Else
Do
Buffer = String(2000, Chr(0))
bSuccess = ReadFile(hReadPipe, Buffer, Len(Buffer), L, 0&)
If bSuccess = 1 Then
frmMain.Text1.Text = frmMain.Text1.Text & Left(Buffer, L)
frmMain.Text1.SelStart = Len(frmMain.Text1.Text)
Else
Err.Raise "Could not interface with GOLF program."
End If
Loop
End If

Call CloseHandle(proc.hProcess)
Call CloseHandle(proc.hThread)
Call CloseHandle(hWritePipe)
Call CloseHandle(hReadPipe)

End Sub

[Kaverin]

If you want to to work with a console, try this out. I've used it before to figure out how to get them working, and it works fine. I'm not sure how to make this invisible though, but it's probably possible.

Option Explicit
 
Public Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Public Declare Function AllocConsole Lib "kernel32" () As Long
Public Declare Function FreeConsole Lib "kernel32" () As Long
Public Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, ByVal lpBuffer As String, ByVal nNumberOfCharsToRead As Long, ByRef lpNumberOfCharsRead As Long, lpReserved As Any) As Long
Public Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, ByVal lpBuffer As String, ByVal nNumberOfCharsToWrite As Long, ByRef lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
 
Public Const STD_INPUT_HANDLE As Long = -10
Public Const STD_OUTPUT_HANDLE As Long = -11
 
Public Sub Main()
   Dim hSTDOut As Long, hSTDIn As Long
   Dim lngTmp As Long
   Dim lngCharCount As Long
   Dim strOutput As String, strInput As String
   Dim i As Long
 
   'attempt to open the console
   lngTmp = AllocConsole
 
   'if it opened, get the handles for stdin and stdout
   If lngTmp Then
      hSTDIn = GetStdHandle(STD_INPUT_HANDLE)
      hSTDOut = GetStdHandle(STD_OUTPUT_HANDLE)
 
      'write some text to the console
      strOutput = "console write test" & vbCrLf
      WriteConsole hSTDOut, strOutput, Len(strOutput), lngCharCount, 0
 
      'get input from the console.  it will end with a vbCrLf, hence the -2 below
      strInput = Space$(1024)
      ReadConsole hSTDIn, strInput, 1020, lngCharCount, 0
      TextBox.Text = Left$(strInput, lngCharCount - 2)
      
      'close and free console
      FreeConsole
   Else
      'stick an error message here
   End If
End Sub