Stefan Thoolen .nl | VB6 Function Database

Attribute VB_Name = "modExec"
' This function is downloaded from:
' http://www.stefanthoolen.nl/archive/vb6-functions/
' 
' You may freely distribute this file but please leave all comments, including this one, in it.
' 
' @Author Stefan Thoolen <mail@stefanthoolen.nl>

Option Explicit

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Any, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Any, ByVal lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Any, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long

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 GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long

Private Declare Function PeekNamedPipe Lib "kernel32" (ByVal hNamedPipe As Long, lpBuffer As Any, ByVal nBufferSize As Long, lpBytesRead As Long, lpTotalBytesAvail As Long, lpBytesLeftThisMessage As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&

Private Const CREATE_NO_WINDOW = &H8000000

Private Const STARTF_USESTDHANDLES = &H100

Private Const STILL_ACTIVE = 259

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Type PROCESS_INFORMATION
        hProcess As Long
        hThread As Long
        dwProcessId As Long
        dwThreadId 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

''
' Execute an external program
' Same syntax as the PHP function 'exec'
' See also: http://www.php.net/manual/en/function.exec.php
'
' If you want to do a general action like "type" or "dir" or other built-in cmd-commands,
' you must prepend the command line tool. For example: "cmd.exe /c dir C:\"
' Otherwise, the command "dir" is unknown.
' If you want to do this with full Win9x support, you can check if you need to use cmd.exe or command.com with the cmd_version()-function
'
' @param    String  cmdline         The command that will be executed.
' @param    Array   outp()          Optional, the specified array will be filled with every line of output from the command. Trailing whitespace, such as \n, is not included in this array.
' @param    Long    retval          The return status of the executed command will be written to this variable.
' @return   String                  The last line from the result of the command
' @author   Stefan Thoolen <mail@stefanthoolen.nl>
Public Function exec(ByVal cmdline As String, Optional ByRef outp As Variant, Optional ByRef retval As Long) As String
    Dim lpSI As STARTUPINFO, lpPI As PROCESS_INFORMATION, PipeAttr As SECURITY_ATTRIBUTES
    Dim l As Long
    
    ' The handles must be inheritable
    PipeAttr.bInheritHandle = True
    PipeAttr.nLength = Len(PipeAttr)
    
    ' Create the StdOut handles
    Dim hStdOutRead As Long, hStdOutWrite As Long
    CreatePipe hStdOutRead, hStdOutWrite, PipeAttr, 0
    
    ' Defines that we use handles to control the command
    lpSI.dwFlags = STARTF_USESTDHANDLES
    lpSI.hStdOutput = hStdOutWrite
    lpSI.cb = Len(lpSI)
    
    l = CreateProcessA(0&, cmdline, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS + CREATE_NO_WINDOW, 0&, 0&, lpSI, lpPI)
    ' Execution failed, we exit with no return values
    If l = 0 Then Exit Function
    
    Dim buffer As String, bufflen As Long, retstr As String
    Dim StopReading As Boolean
    Do
        StopReading = True
        ' Waits for output
        WaitForSingleObject lpPI.hProcess, 1
        ' Checks if the app is still active
        l = GetExitCodeProcess(lpPI.hProcess, retval)
        If retval = STILL_ACTIVE Then StopReading = False
        ' Read the length of the buffer
        l = PeekNamedPipe(hStdOutRead, 0&, 0&, 0&, bufflen, 0&)
        If bufflen > 0 Then
            buffer = String(bufflen, 0)
            ' Reads the buffer
            l = ReadFile(hStdOutRead, buffer, Len(buffer), bufflen, 0&)
            buffer = Left$(buffer, bufflen)
            ' Adds the buffer to the response
            retstr = retstr & buffer
        End If
    Loop Until StopReading
    
    ' Closes our handle to the process
    CloseHandle lpPI.hProcess
    CloseHandle lpPI.hThread
    CloseHandle hStdOutRead: CloseHandle hStdOutWrite
    
    ' No output at all
    If retstr = "" Then Exit Function
    ' All rows in an array with CrLf
    outp = Split(retstr, vbCrLf)
    ' Appairently only one row, lets try with only a Lf
    If LBound(outp) = UBound(outp) Then outp = Split(retstr, vbLf)
    ' Last line
    exec = outp(UBound(outp))
    ' Last line is empty, so we pick the previous line (happens most of the time)
    If exec = "" And UBound(outp) > LBound(outp) Then exec = outp(UBound(outp) - 1)
End Function
Visual Basic 6 function "exec"

Go back
