zoukankan      html  css  js  c++  java
  • 如何截获执行命令行的输出

    Option Explicit
    Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, 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 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
    Private Declare Function CreateProcessAsUser Lib "advapi32.dll" Alias "CreateProcessAsUserA" (ByVal hToken As Long, ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As SECURITY_ATTRIBUTES, ByVal lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As String, ByVal lpCurrentDirectory As String, ByVal lpStartupInfo As STARTUPINFO, ByVal lpProcessInformation As PROCESS_INFORMATION) As Long
    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
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Const NORMAL_PRIORITY_CLASS = &H20
    Private Const STARTF_USESTDHANDLES = &H100
    Private Const STARTF_USESHOWWINDOW = &H1
    Private Function ExecuteCommandLineOutput(CommandLine As String, Optional BufferSize As Long = 256, Optional TimeOut As Long) As String
     Dim Proc As PROCESS_INFORMATION
     Dim Start As STARTUPINFO
     Dim SA As SECURITY_ATTRIBUTES
     Dim hReadPipe As Long
     Dim hWritePipe As Long
     Dim lBytesRead As Long
     Dim sBuffer As String
     If VBA.Len(CommandLine) > 0 Then
      SA.nLength = Len(SA)
      'SA.nLength = vba.Len(sa)
      SA.bInheritHandle = 1&
      SA.lpSecurityDescriptor = 0&
      If CreatePipe(hReadPipe, hWritePipe, SA, 0) > 0 Then
       Start.cb = Len(Start)
       Start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
       Start.hStdOutput = hWritePipe
       Start.hStdError = hWritePipe
       If CreateProcessA(0&, CommandLine, SA, SA, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, Start, Proc) = 1 Then
        CloseHandle hWritePipe
        sBuffer = VBA.String(BufferSize, VBA.Chr(0))
        If TimeOut > 0 Then
         Dim BeginTime As Date
         BeginTime = VBA.Now
        End If
        Do Until ReadFile(hReadPipe, sBuffer, BufferSize, lBytesRead, 0&) = 0
         DoEvents
         If TimeOut > 0 Then
          If VBA.DateDiff("s", BeginTime, VBA.Now) > TimeOut Then
           ExecuteCommandLineOutput = "Timeout"
           Exit Do
          End If
         End If
         ExecuteCommandLineOutput = ExecuteCommandLineOutput & VBA.Left(sBuffer, lBytesRead)
        Loop
        CloseHandle Proc.hProcess
        CloseHandle Proc.hThread
        CloseHandle hReadPipe
       Else
        ExecuteCommandLineOutput = "File or command not found"
       End If
      Else
       ExecuteCommandLineOutput = "CreatePipe failed. Error: " & Err.LastDllError & "."
      End If
     End If
    End Function
    Private Sub Command1_Click() '测试
     'VBA.MsgBox ExecuteCommandLineOutput("ping www.sina.com.cn")
     VBA.MsgBox ExecuteCommandLineOutput("ping www.xxxx.com.cn", , 2)
    End Sub
  • 相关阅读:
    贾庆山老师对研究生做学术的几点建议
    normalization flow
    PP: Robust Anomaly Detection for Multivariate Time Series through Stochastic Recurrent Neural Network
    PP: Multi-Horizon Time Series Forecasting with Temporal Attention Learning
    Attention machenism
    PP: Modeling extreme events in time series prediction
    Learn from Niu 2020.1.28
    Big research problems (1)
    PP: UMAP: uniform manifold approximation and projection for dimension reduction
    Dimension reduction
  • 原文地址:https://www.cnblogs.com/Microshaoft/p/2485793.html
Copyright © 2011-2022 走看看