Re: ECHO DOS results

I once found an example of how to do that. I didn't end up needing it,
so can't vouch for it. This was written by Mattias Sjögren
(mattias@xxxxxxxx)

HTH...

Jennifer


Watch for word wrap....

In a module named MMain.bas:
'' ----------BEGIN CODE----------

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Name: MMain
'' Filename: MMain.bas
'' Project: CommandOutput sample 1
'' Author: Mattias Sjögren (mattias@xxxxxxxx)
'' http://www.msjogren.net/dotnet/
''
'' Description: Startup module
''
'' Dependencies: MGetCmdOutput module (MGetCmdOutput.bas)
''
''
'' Copyright ©2000-2001, Mattias Sjögren
''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

Sub Main()

' Get both STDOUT and STDERR, and convert DOS characters to Windows
MsgBox GetCommandOutput("consoleapp.exe", True, True, True)

' Get both STDOUT and STDERR, but without conversion this time
MsgBox GetCommandOutput("consoleapp.exe", True, True, False)

' Get only STDOUT
MsgBox GetCommandOutput("consoleapp.exe", True, False, True)

' Get only STDERR
MsgBox GetCommandOutput("consoleapp.exe", False, True, True)

End Sub

''---------------------END CODE in MMain.bas

In module named: MGetCmdOutput.bas:


''------------------------BEGIN CODE in MGetCmdOutput.bas

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Name: MGetCmdOutput
'' Filename: MGetCmdOutput.bas
'' Author: Mattias Sjögren (mattias@xxxxxxxx)
'' http://www.msjogren.net/dotnet/
''
'' Description: Generic module for launching a console app and
'' capture its output.
''
''
'' Copyright ©2000-2001, Mattias Sjögren
''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

'''''''''''''''''''''
''' Constants '''
'''''''''''''''''''''

' STARTUPINFO flags
Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESTDHANDLES = &H100

' ShowWindow flags
Private Const SW_HIDE = 0

' DuplicateHandle flags
Private Const DUPLICATE_CLOSE_SOURCE = &H1
Private Const DUPLICATE_SAME_ACCESS = &H2

' Error codes
Private Const ERROR_BROKEN_PIPE = 109


'''''''''''''''''
''' Types '''
'''''''''''''''''

Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
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


''''''''''''''''''''
''' Declares '''
''''''''''''''''''''

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, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
lpOverlapped As Any) As Long

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 GetCurrentProcess Lib "kernel32" () As Long

Private Declare Function DuplicateHandle Lib "kernel32" ( _
ByVal hSourceProcessHandle As Long, _
ByVal hSourceHandle As Long, _
ByVal hTargetProcessHandle As Long, _
lpTargetHandle As Long, _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwOptions As Long) As Long

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

Private Declare Function OemToCharBuff Lib "user32" Alias
"OemToCharBuffA" ( _
lpszSrc As Any, _
ByVal lpszDst As String, _
ByVal cchDstLength As Long) As Long


''''''''''''''''''''''''''
''' Public methods '''
''''''''''''''''''''''''''

'
' Function GetCommandOutput
'
' sCommandLine: [in] Command line to launch
' fStdOut [in,opt] True (defualt) to capture output to STDOUT
' fStdErr [in,opt] True to capture output to STDERR. False is
default.
' fOEMConvert: [in,opt] True (default) to convert DOS characters to
Windows, False to skip conversion
'
' Returns: String with STDOUT and/or STDERR output
'
Public Function GetCommandOutput(sCommandLine As String, Optional
fStdOut As Boolean = True, _
Optional fStdErr As Boolean = False,
Optional fOEMConvert As Boolean = True) As String

Dim hPipeRead As Long, hPipeWrite1 As Long, hPipeWrite2 As Long
Dim hCurProcess As Long
Dim sa As SECURITY_ATTRIBUTES
Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION
Dim baOutput() As Byte
Dim sNewOutput As String
Dim lBytesRead As Long
Dim fTwoHandles As Boolean

Dim lRet As Long


Const BUFSIZE = 1024 ' pipe buffer size

' At least one of them should be True, otherwise there's no point in
calling the function
If (Not fStdOut) And (Not fStdErr) Then Err.Raise 5 ' Invalid
Procedure call or Argument

' If both are true, we need two write handles. If not, one is enough.
fTwoHandles = fStdOut And fStdErr

ReDim baOutput(BUFSIZE - 1) As Byte

With sa
.nLength = Len(sa)
.bInheritHandle = 1 ' get inheritable pipe handles
End With

If CreatePipe(hPipeRead, hPipeWrite1, sa, BUFSIZE) = 0 Then Exit
Function

hCurProcess = GetCurrentProcess()

' Replace our inheritable read handle with an non-inheritable. Not
that it
' seems to be necessary in this case, but the docs say we should.
Call DuplicateHandle(hCurProcess, hPipeRead, hCurProcess, hPipeRead,
0&, _
0&, DUPLICATE_SAME_ACCESS Or
DUPLICATE_CLOSE_SOURCE)

' If both STDOUT and STDERR should be redirected, get an extra
handle.
If fTwoHandles Then
Call DuplicateHandle(hCurProcess, hPipeWrite1, hCurProcess,
hPipeWrite2, 0&, _
1&, DUPLICATE_SAME_ACCESS)
End If

With si
.cb = Len(si)
.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
.wShowWindow = SW_HIDE ' hide the window

If fTwoHandles Then
.hStdOutput = hPipeWrite1
.hStdError = hPipeWrite2
ElseIf fStdOut Then
.hStdOutput = hPipeWrite1
Else
.hStdError = hPipeWrite1
End If
End With

If CreateProcess(vbNullString, sCommandLine, ByVal 0&, ByVal 0&, 1,
0&, _
ByVal 0&, vbNullString, si, pi) Then

' Close thread handle - we don't need it
Call CloseHandle(pi.hThread)

' Also close our handle(s) to the write end of the pipe. This is
important, since
' ReadFile will *not* return until all write handles are closed or
the buffer is full.
Call CloseHandle(hPipeWrite1)
hPipeWrite1 = 0
If hPipeWrite2 Then
Call CloseHandle(hPipeWrite2)
hPipeWrite2 = 0
End If

Do
' Add a DoEvents to allow more data to be written to the buffer
for each call.
' This results in fewer, larger chunks to be read.
'DoEvents

If ReadFile(hPipeRead, baOutput(0), BUFSIZE, lBytesRead, ByVal
0&) = 0 Then Exit Do

If fOEMConvert Then
' convert from "DOS" to "Windows" characters
sNewOutput = String$(lBytesRead, 0)
Call OemToCharBuff(baOutput(0), sNewOutput, lBytesRead)
Else
' perform no conversion (except to Unicode)
sNewOutput = Left$(StrConv(baOutput(), vbUnicode), lBytesRead)
End If

GetCommandOutput = GetCommandOutput & sNewOutput

' If you are executing an application that outputs data during a
long time,
' and don't want to lock up your application, it might be a
better idea to
' wrap this code in a class module in an ActiveX EXE and execute
it asynchronously.
' Then you can raise an event here each time more data is
available.
'RaiseEvent OutputAvailabele(sNewOutput)
Loop

' When the process terminates successfully, Err.LastDllError will
be
' ERROR_BROKEN_PIPE (109). Other values indicates an error.

Call CloseHandle(pi.hProcess)

End If

' clean up
Call CloseHandle(hPipeRead)
If hPipeWrite1 Then Call CloseHandle(hPipeWrite1)
If hPipeWrite2 Then Call CloseHandle(hPipeWrite2)

End Function

''------------------------End code in MGetCmdOutput.bas
---------------------

.

Relevant Pages

  • Re: Alpha search to load a list box
    ... Dim strTemp As String ... Private Sub LblAlpha_MouseDown(Button As Integer, Shift As Integer, X ... Dim StartX As Long, WidthX As Long ... Private Declare Function apiSelectObject Lib "gdi32" Alias ...
    (microsoft.public.access.formscoding)
  • Re: Alpha search to load a list box
    ... Dim strTemp As String ... Private Declare Function apiSelectObject Lib "gdi32" Alias ... Dim newfont As Long ' Handle to our Font Object we created. ...
    (microsoft.public.access.formscoding)
  • ListView.SelectedItem cannot be modified
    ... Dim objFind As LV_FINDINFO ... Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd ... lpClassName As String, ByVal lpWindowName As String) As Long ... 'CompareDates: This is the sorting routine that gets passed to the ...
    (microsoft.public.vb.controls)
  • Re: Need to call windows scheduler.
    ... Private Declare Function OpenSCManager Lib "advapi32.dll" Alias ... "OpenSCManagerA" (ByVal lpMachineName As String, ... Dim lhSCM As Long, lhService As Long, sState As String, lReturn ...
    (microsoft.public.access.formscoding)
  • Re: changing vbOKCancel button title
    ... Private Declare Function GetCurrentThreadId Lib "kernel32" _ ... ByVal lpCaption As String, _ ... Dim mbFlags2 As VbMsgBoxStyle ... SetDlgItemText wParam, vbAbort, But1 ...
    (microsoft.public.excel.misc)