在 VB6 中从命令行获取输出 [英] Get output from command line in VB6

问题描述

我正在使用此 .Cls 文件和使用 7zip 的命令从 zip 中提取特定文件.

我的单个文件如何被提取我需要添加 if 语句来确定我的文件是否被找到，以便我可以退出它

这段代码是否可以修改以添加自己的代码
DOSOutputs.cls

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

按钮命令

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 有

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

所以现在我正在尝试使用 if 语句从输出中获取状态以判断是否找到了 41_gfx7.rom，以便我可以退出扫描或子程序，因为无需进一步扫描.

或者，如果您可以帮助添加更好的一个，那就太好了，一旦找到字符串退出子它

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 是我的命令

text6 is my command

好的更新

"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

我需要根据 https://sevenzip 添加列表到这个命令.osdn.jp/chm/cmdline/commands/list.htm 以便在输出数据中显示文件名

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

推荐答案

以下 Microsoft 文章描述了两种读取命令输出的方法:WSH:运行程序

The following Microsoft article describes two methods that read the output of a command: WSH: Running Programs

最简单的使用 WshExec 对象的 StdOut 属性:

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

您可以用您的 7z 命令替换此处的 ping 命令并阅读 StdOut 以查看您的命令返回的内容.

You can replace the ping command here with your 7z command and read StdOut to see what your command returned.

由于您是在 VB6 中执行此操作，因此您可以添加对 Windows 脚本宿主对象模型库的引用(项目菜单 > 引用)，并直接使用正确的类型实例化对象:

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

通过这种方法，您不需要 DOSCommand.cls，您可以简单地使用 WshShell 对象进行所有操作.

With this approach you don't need the DOSCommand.cls, you can simply use the WshShell object for all your operations.

您的 Command22_Click 将如下所示:

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

这篇关于在 VB6 中从命令行获取输出的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！