codecaine

VBA read STDOUT

Jun 12th, 2021
871
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2.  
  3. Private Type SECURITY_ATTRIBUTES
  4.     nLength As Long
  5.     lpSecurityDescriptor As Long
  6.     bInheritHandle As Long
  7. End Type
  8.  
  9. Private Type PROCESS_INFORMATION
  10.     hProcess As Long
  11.     hThread As Long
  12.     dwProcessId As Long
  13.     dwThreadId As Long
  14. End Type
  15.  
  16. Private Type STARTUPINFO
  17.     cb As Long
  18.     lpReserved As Long
  19.     lpDesktop As Long
  20.     lpTitle As Long
  21.     dwX As Long
  22.     dwY As Long
  23.     dwXSize As Long
  24.     dwYSize As Long
  25.     dwXCountChars As Long
  26.     dwYCountChars As Long
  27.     dwFillAttribute As Long
  28.     dwFlags As Long
  29.     wShowWindow As Integer
  30.     cbReserved2 As Integer
  31.     lpReserved2 As Byte
  32.     hStdInput As Long
  33.     hStdOutput As Long
  34.     hStdError As Long
  35. End Type
  36.  
  37. Private Const WAIT_INFINITE         As Long = (-1&)
  38. Private Const STARTF_USESHOWWINDOW  As Long = &H1
  39. Private Const STARTF_USESTDHANDLES  As Long = &H100
  40. Private Const SW_HIDE               As Long = 0&
  41.  
  42. Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
  43. Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As Long, 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
  44. 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
  45. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  46. Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
  47. Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
  48. Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
  49. Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
  50.  
  51. Public Function Redirect(szBinaryPath As String, szCommandLn As String) As String
  52.  
  53. Dim tSA_CreatePipe              As SECURITY_ATTRIBUTES
  54. Dim tSA_CreateProcessPrc        As SECURITY_ATTRIBUTES
  55. Dim tSA_CreateProcessThrd       As SECURITY_ATTRIBUTES
  56. Dim tSA_CreateProcessPrcInfo    As PROCESS_INFORMATION
  57. Dim tStartupInfo                As STARTUPINFO
  58. Dim hRead                       As Long
  59. Dim hWrite                      As Long
  60. Dim bRead                       As Long
  61. Dim abytBuff()                  As Byte
  62. Dim lngResult                   As Long
  63. Dim szFullCommand               As String
  64. Dim lngExitCode                 As Long
  65. Dim lngSizeOf                   As Long
  66.  
  67. tSA_CreatePipe.nLength = Len(tSA_CreatePipe)
  68. tSA_CreatePipe.lpSecurityDescriptor = 0&
  69. tSA_CreatePipe.bInheritHandle = True
  70.  
  71. tSA_CreateProcessPrc.nLength = Len(tSA_CreateProcessPrc)
  72. tSA_CreateProcessThrd.nLength = Len(tSA_CreateProcessThrd)
  73.  
  74. If (CreatePipe(hRead, hWrite, tSA_CreatePipe, 0&) <> 0&) Then
  75.     tStartupInfo.cb = Len(tStartupInfo)
  76.     GetStartupInfo tStartupInfo
  77.  
  78.     With tStartupInfo
  79.         .hStdOutput = hWrite
  80.         .hStdError = hWrite
  81.         .dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
  82.         .wShowWindow = SW_HIDE
  83.     End With
  84.    
  85.     szFullCommand = """" & szBinaryPath & """" & " " & szCommandLn
  86.     lngResult = CreateProcess(0&, szFullCommand, tSA_CreateProcessPrc, tSA_CreateProcessThrd, True, 0&, ByVal 0&, vbNullString, tStartupInfo, tSA_CreateProcessPrcInfo)
  87.  
  88.     If (lngResult <> 0&) Then
  89.         lngResult = WaitForSingleObject(tSA_CreateProcessPrcInfo.hProcess, WAIT_INFINITE)
  90.         lngSizeOf = GetFileSize(hRead, 0&)
  91.         If (lngSizeOf > 0) Then
  92.             ReDim abytBuff(lngSizeOf - 1)
  93.             If ReadFile(hRead, abytBuff(0), UBound(abytBuff) + 1, bRead, ByVal 0&) Then
  94.                 Redirect = StrConv(abytBuff, vbUnicode)
  95.             End If
  96.         End If
  97.         Call GetExitCodeProcess(tSA_CreateProcessPrcInfo.hProcess, lngExitCode)
  98.         CloseHandle tSA_CreateProcessPrcInfo.hThread
  99.         CloseHandle tSA_CreateProcessPrcInfo.hProcess
  100.                
  101.         If (lngExitCode <> 0&) Then Err.Raise vbObject + 1235&, "GetExitCodeProcess", "Non-zero Application exist code"
  102.        
  103.         CloseHandle hWrite
  104.         CloseHandle hRead
  105.     Else
  106.         Err.Raise vbObject + 1236&, "CreateProcess", "CreateProcess Failed, Code: " & Err.LastDllError
  107.     End If
  108. End If
  109. End Function
RAW Paste Data