Get output from command line in VB6 - vb6

Question

i am using this .Cls file and a command using 7zip to extract specific file from a zip.
my single file gets extracted how ever i need to add if statement to se if my file was found so that i can exit sub it can this piece of code be modifed to add own code
DOSOutputs.cls
Option Explicit
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MsgType, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function TranslateMessage Lib "user32" (ByRef lpMsg As Any) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageW" (ByRef lpMsg As Any) As Long
Private Type POINTAPI
x As Long
Y As Long
End Type
Private Type MsgType
hWnd As Long
message As Long
wParam As Long
lParam As Long
Time As Long
pt As POINTAPI
End Type
Private Const PM_NOREMOVE As Long = 0&
Private Const PM_REMOVE As Long = 1&
'
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'The CreatePipe function creates an anonymous pipe,
'and returns handles to the read and write ends of the pipe.
Private Declare Function CreatePipe Lib "kernel32" ( _
phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As Any, _
ByVal nSize As Long) As Long
'Used to read the the pipe filled by the process create
'with the CretaProcessA function
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
'Structure used by the CreateProcessA function
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
'Structure used by the CreateProcessA function
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
'Structure used by the CreateProcessA function
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
'This function launch the the commend and return the relative process
'into the PRECESS_INFORMATION structure
Private 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
'Close opened handle
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hHandle As Long) As Long
'Consts for the above functions
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private mCommand As String 'Private variable for the CommandLine property
Private mOutputs As String 'Private variable for the ReadOnly Outputs property
'Event that notify the temporary buffer to the object
Public Event ReceiveOutputs(CommandOutputs As String)
'This property set and get the DOS command line
'It's possible to set this property directly from the
'parameter of the ExecuteCommand method
Public Property Let CommandLine(DOSCommand As String)
mCommand = DOSCommand
End Property
Public Property Get CommandLine() As String
CommandLine = mCommand
End Property
'This property ReadOnly get the complete output after
'a command execution
Public Property Get Outputs()
Outputs = mOutputs
End Property
Public Function ExecuteCommand(Optional CommandLine As String) As String
Dim proc As PROCESS_INFORMATION 'Process info filled by CreateProcessA
Dim ret As Long 'long variable for get the return value of the
'API functions
Dim start As STARTUPINFO 'StartUp Info passed to the CreateProceeeA
'function
Dim sa As SECURITY_ATTRIBUTES 'Security Attributes passeed to the
'CreateProcessA function
Dim hReadPipe As Long 'Read Pipe handle created by CreatePipe
Dim hWritePipe As Long 'Write Pite handle created by CreatePipe
Dim lngBytesread As Long 'Amount of byte read from the Read Pipe handle
Dim strBuff As String * 256 'String buffer reading the Pipe
'if the parameter is not empty update the CommandLine property
If Len(CommandLine) > 0 Then
mCommand = CommandLine
End If
'if the command line is empty then exit whit a error message
If Len(mCommand) = 0 Then
MsgBox "Command Line empty", vbCritical
Exit Function
End If
'Create the Pipe
sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
'If an error occur during the Pipe creation exit
MsgBox "CreatePipe failed. Error: " & Err.LastDllError, vbCritical
Exit Function
End If
'Launch the command line application
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
'set the StdOutput and the StdError output to the same Write Pipe handle
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
'Execute the command
ret& = CreateProcessA(0&, mCommand, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If ret <> 1 Then
'if the command is not found ....
MsgBox "File or command not found", vbCritical
Exit Function
End If
'Now We can ... must close the hWritePipe
ret = CloseHandle(hWritePipe)
mOutputs = ""
'Read the ReadPipe handle
Do
ret = ReadFile(hReadPipe, strBuff, 256, lngBytesread, 0&)
mOutputs = mOutputs & Left(strBuff, lngBytesread)
'Send data to the object via ReceiveOutputs event
RaiseEvent ReceiveOutputs(Left(strBuff, lngBytesread))
'Pause 0.02
FastDoEvents
Loop While ret <> 0
'Close the opened handles
ret = CloseHandle(proc.hProcess)
ret = CloseHandle(proc.hThread)
ret = CloseHandle(hReadPipe)
'Return the Outputs property with the entire DOS output
ExecuteCommand = mOutputs
End Function
Public Sub FastDoEvents()
Dim uMsg As MsgType
'
Do While PeekMessage(uMsg, 0&, 0&, 0&, PM_REMOVE) ' Reads and deletes message from queue.
TranslateMessage uMsg ' Translates virtual-key messages into character messages.
DispatchMessage uMsg ' Dispatches a message to a window procedure.
Loop
End Sub
form1
Private WithEvents objDOS As DOSOutputs
Private Sub Form_Load()
Set objDOS = New DOSOutputs
End Sub
button command
Private Sub Command22_Click()
On Error Resume Next
On Error GoTo errore
objDOS.CommandLine = text6.text
objDOS.ExecuteCommand
'If objDOS.Outputs = "41_gfx7.rom " Then
'Text1.Text = Text1.Text & objDOS.Outputs & vbNewLine
'End If
Exit Sub
errore:
MsgBox (Err.Description & " - " & Err.Source & " - " & CStr(Err.Number))
End Sub
text6.text has
"C:\Program Files (x86)\7-Zip\7z" x "C:\Users\sarah\Downloads\MAME\MAME_2010_full_nonmerged_romsets\roms\*.zip" -o"C:\Users\sarah\Desktop\rom test\New folder (2)\" *41_gfx7.rom -y
so now am trying to get the status from output using if statement to se if 41_gfx7.rom was found so that i can exit the scan or sub as there is no need to scan further.
or maybe if you can help add better one it will be great,once the string is found exit sub it
Private Sub Command1_Click()
Dim objShell As New WshShell
Dim objExecObject As WshExec
Dim strText As String
Set objExecObject = objShell.Exec(Text6.Text)
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
If InStr(strText, "Reply") > 0 Then
Debug.Print "Reply received: " & strText
Exit Do
End If
Loop
End Sub
text6 is my command
ok update
"C:\Program Files (x86)\7-Zip\7z" x "C:\Users\sarah\Downloads\MAME\MAME_2010_full_nonmerged_romsets\roms\*.zip" -o"C:\Users\sarah\Desktop\rom test\New folder (2)\" *41_gfx7.rom -y
i need to add list to this command according to https://sevenzip.osdn.jp/chm/cmdline/commands/list.htm so that file names gets displayed in output data

Answer 1

The following Microsoft article describes two methods that read the output of a command: WSH: Running Programs
The simplest uses the StdOut property of the WshExec object:
Set objShell = WScript.CreateObject("WScript.Shell")
Set objExecObject = objShell.Exec("cmd /c ping -n 3 -w 1000 157.59.0.1")
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
If Instr(strText, "Reply") > 0 Then
Wscript.Echo "Reply received."
Exit Do
End If
Loop
You can replace the ping command here with your 7z command and read StdOut to see what your command returned.
Since you are doing this in VB6, you can add a reference (Projects menu > References) to Windows Script Host Object Model library and instantiate the objects with the proper types directly:
Dim objShell As New WshShell
Dim objExecObject As WshExec
Dim strText As String
Set objExecObject = objShell.Exec("cmd /c ping -n 3 -w 1000 127.0.0.1")
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
If InStr(strText, "Reply") > 0 Then
Debug.Print "Reply received: " & strText
Exit Do
End If
Loop
With this approach you don't need the DOSCommand.cls, you can simply use the WshShell object for all your operations.
Your Command22_Click would look like this:
Private Sub Command22_Click()
On Error GoTo errore
Dim objShell As New WshShell
Dim objExecObject As WshExec
Dim strText As String
Set objExecObject = objShell.Exec(text6.Text)
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
' Parse the text your 7z command returned here
If InStr(strText, "41_gfx7.rom") > 0 Then
Text1.Text = Text1.Text & strText & vbCrLf
Exit Do
End If
Loop
Exit Sub
errore:
MsgBox (Err.Description & " - " & Err.Source & " - " & CStr(Err.Number))
End Sub