Reading application output

From HashVB
Revision as of 08:54, 25 April 2007 by Dee (Talk | contribs)

Jump to: navigation, search
float
 This article is based on Visual Basic 6. Find other Visual Basic 6 articles.
 This article is currently work in progress. Please come back later.
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, 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
'Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal HHandle As Long, ByVal dwMilliseconds As Long) 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 Const NORMAL_PRIORITY_CLASS = &H20

Private Const INFINITE = &HFFFF
Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESTDHANDLES = &H100
Private Const SW_HIDE = 0

Function ShellToVariable(ByVal cmdLine As String, ByRef Output As String) As Long
Dim ReadPipe As Long
Dim WritePipe As Long
Dim SA As SECURITY_ATTRIBUTES
Dim SI As STARTUPINFO
Dim PI As PROCESS_INFORMATION
Dim Data() As Byte
Dim Length As Long

  'Set up the Security Attributes
  SA.nLength = Len(SA)
  SA.lpSecurityDescriptor = 0
  SA.bInheritHandle = 1
  
  'Create the pipe
  If CreatePipe(ReadPipe, WritePipe, SA, 0) = 0 Then
    Exit Function
  End If

  'Set up the window state and STDIO handles
  SI.cb = Len(SI)
  SI.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
  SI.wShowWindow = SW_HIDE
  SI.hStdInput = 0
  SI.hStdOutput = WritePipe
  SI.hStdError = WritePipe

  'Try and run the process
  If CreateProcess(vbNullString, cmdLine, SA, SA, 1, NORMAL_PRIORITY_CLASS, vbNullString, vbNullString, SI, PI) = 0 Then
    Exit Function
  End If
  'Wait for the process to exit
  WaitForSingleObject PI.hProcess, INFINITE
  'Close both handles so it can shut down correctly
  CloseHandle PI.hProcess
  CloseHandle PI.hThread

  'Attempt to read the data (1K is enough for now)
  Length = 1024
  ReDim Data(Length - 1)
  If ReadFile(ReadPipe, Data(0), Length, Length, 0) = 0 Then
    Data = ""
  Else
    ReDim Preserve Data(Length - 1)
  End If

  Output = StrConv(Data, vbUnicode)

  'Close the pipe handles
  CloseHandle ReadPipe
  CloseHandle WritePipe
End Function