如何截获执行命令行的输出

关注

原创最新推荐文章于 2025-08-20 06:38:40 发布 1.3k 阅读 AI 写同款· GEO 优化 ›

Cibersort免疫浸润 --- 详细教程免疫浸润是指免疫细胞如淋巴细胞、浆细胞、巨噬细胞等进入到组织或器官中，并在这些组织或器官中发挥免疫功能的过程。免疫细胞的浸润可以是炎症反应的一部分，也可以是针对感染、肿瘤或其他疾病的免疫应答的一部分。免疫浸润通过调节免疫反应和炎症反应的程度和类型，起到维护机体免疫平衡和清除异常细胞或病原体的作用。在某些情况下，免疫浸润可能导致炎症反应过度，引起组织损伤，例如自身免疫性疾病。因此，免疫浸润在许多疾病的诊断和治疗中都具有重要的意义。免疫浸润可以通过组织切片染色和免疫组织化学等方法观察和分析。阅读详情

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

收录于