Solved

CreateProcess/Pipe Problem

Posted on 2004-03-27
7
1,777 Views
Last Modified: 2008-02-20
Here is what I am trying to do. I am trying to create a program that will spawn a DOS Program and then redirect the output to a byte array and then I also want to be able to send input to the DOS Program via a byte buffer. The only way I could think of doing this to keep the process open and allow the user to send the input was to create a Class Module, below is what I have so far.


Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
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 SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
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
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
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 Long
 lpDesktop As Long
 lpTitle As Long
 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 Byte
 hStdInput As Long
 hStdOutput As Long
 hStdError As Long
End Type
Private Type OVERLAPPED
   ternal As Long
   ternalHigh As Long
   offset As Long
   OffsetHigh As Long
   hEvent As Long
End Type
Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESTDHANDLES = &H100
Private Const SW_HIDE = 0
Private Const EM_SETSEL = &HB1
Private Const EM_REPLACESEL = &HC2
Private hStdOut As Long, hStdIn As Long 'pipes for use by the Shell
Private hRead As Long 'Pipes used by us ;/
Private hWrite As Long
Private ProcessAttrib As SECURITY_ATTRIBUTES
Public Function CreateCMD()
Dim startInfo As STARTUPINFO
Dim lngPipe1ret As Long, lngPipe2ret As Long
Dim lngProcessRet As Long
Dim ProcessInfo As PROCESS_INFORMATION
Dim pipeAttrib As SECURITY_ATTRIBUTES
Dim ThreadAttrib As SECURITY_ATTRIBUTES

'Create Two Pipes
pipeAttrib.nLength = Len(pipeAttrib)
pipeAttrib.lpSecurityDescriptor = 0
pipeAttrib.bInheritHandle = True
lngPipe1ret = CreatePipe(hRead, hStdOut, pipeAttrib, 0)     'hStdOut -> hRead
lngPipe2ret = CreatePipe(hStdIn, hWrite, pipeAttrib, 0)       'hWrite -> hStdIn

'make sure pipes were created
If (lngPipe1ret = 0) Or (lngPipe2ret = 0) Then
    CreateCMD = -2  'return -2 and exit
    Exit Function
End If

'Set Startup Info
startInfo.cb = Len(startInfo)
GetStartupInfo startInfo

'Set Pipes
startInfo.hStdOutput = hStdOut
startInfo.hStdError = hStdOut
startInfo.hStdInput = hStdIn

'Set Flags
startInfo.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
startInfo.wShowWindow = SW_HIDE

'Create the process
ProcessAttrib.nLength = Len(ProcessAttrib)
ThreadAttrib.nLength = Len(ThreadAttrib)
lngProcessRet = CreateProcess(vbNullString, "program.exe", ProcessAttrib, ThreadAttrib, True, 0, Null, vbNullString, startInfo, processInfo)
If lngProcessRet > 0 Then
    CreateCMD = ProcessInfo.dwProcessId
Else
    CreateCMD = -1
End If
End Function

Public Function ReadCMD() As Byte()
Dim lngRet As Long
Dim lngBytesRead As Long
Dim byteBuff(1024) As Byte
lngRet = ReadFile(hRead, byteBuff(0), 1023, lngBytesRead, 0&)
End Function




As of now the CreateCMD works, however, when I do a readCMD it reads the data, but right after that my program freezes.




Here is the code I am using in my form:

Private cmdShell As New cmd
Private hasShell As Boolean

Private Sub Form_Load()
Dim retCode As Long
retCode = cmdShell.CreateCMD
If retCode > 0 Then hasShell = True
End Sub

Private Sub Timer1_Timer()
Dim byteBuff(1024) As Byte
If hasShell = True Then
    byteBuff(0) = cmdShell.ReadCMD
   ' Text1.Text = Text1.Text & byteBuff()  <--- dont pay attention to this, just for testing
End If
End Sub



if I disable the timer after the first call of ReadCmd it wont freeze on me, however, I need to be able to let the program to hang out until the user tells it what to do.


-Brian
0
Comment
Question by:BrianGEFF719
  • 4
  • 2
7 Comments
 
LVL 19

Author Comment

by:BrianGEFF719
Comment Utility
I think it only freezes when there is nothing to read in the pipe? Any suggests of how to be alerted when there is data in the pipe to be read?
0
 
LVL 6

Expert Comment

by:___XXX_X_XXX___
Comment Utility
I try your example above.
Program hangs when no data is available from your console application.
To try this change:
Public Function ReadCMD() As Byte()
Dim lngRet As Long
Dim lngBytesRead As Long
Dim byteBuff(1024) As Byte
lngRet = ReadFile(hRead, byteBuff(0), 1023, lngBytesRead, 0&)
End Function

To

Public Function ReadCMD() As Byte()
Dim lngRet As Long
Dim lngBytesRead As Long
Dim byteBuff(1024) As Byte
lngRet = ReadFile(hRead, byteBuff(0), 10, lngBytesRead, 0&) ' Read only 10 bytes from console
 ' When you read about 14 times (140 bytes) there are no more bytes available from console application
 ' Because ReadFile is synchronous function, it will release control to your application when some data is available from your console application.
End Function

I think that ReadFile always will hand your application until data is available.

Try using ReadFileEx with Overlapped structure and some Your defined Function that will be executed from windows when data is available. Then you program will not hang on ReadFile.
0
 
LVL 19

Author Comment

by:BrianGEFF719
Comment Utility
I am not understanding that, i am going to retrieve the data from the pipe as soon as the process is created. Then the user is going to write data to the write pipe, I need to be able to check when data is ready in the read pipe, because the console program is going to do some processing? Do you understand now?
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 6

Expert Comment

by:___XXX_X_XXX___
Comment Utility
Yes, understand, but you use ReadFile as synchronous function, and when no data is available your program have no chance to continue it's execution.
Use ReadFileEx:

The ReadFileEx function reads data from a file asynchronously. It is designed solely for asynchronous operation, unlike the ReadFile function, which is designed for both synchronous and asynchronous operation. ReadFileEx lets an application perform other processing during a file read operation.

The ReadFileEx function reports its completion status asynchronously, calling a specified completion routine when reading is completed and the calling thread is in an alertable wait state.


BOOL ReadFileEx(

    HANDLE hFile,      // handle of file to read
    LPVOID lpBuffer,      // address of buffer
    DWORD nNumberOfBytesToRead,      // number of bytes to read
    LPOVERLAPPED lpOverlapped,      // address of offset
    LPOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine       // address of completion routine
   );


lpCompletionRoutine

Points to the completion routine to be called when the read operation is complete and the calling thread is in an alertable wait state. For more information about the completion routine, see FileIOCompletionRoutine.
0
 
LVL 19

Author Comment

by:BrianGEFF719
Comment Utility
I am a little confused by ReadFileEx, could you possibly provide an example?


Should it be something like this


dim over_lapped as OverLapped
dim boolRet as boolean

boolRet = ReadFileEx(readPipe,byteBuff(0),1023,over_lapped, AddressOf NextFunction)
0
 
LVL 19

Author Comment

by:BrianGEFF719
Comment Utility
But the question is, why does ReadFile freeze my application when no data is availible?


-Brian
0
 
LVL 4

Accepted Solution

by:
sokolovsky earned 500 total points
Comment Utility
The answer is simple:

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

Set lpBuffer to ByVal 0& (we only want to check). So, nBufferSize = 0,  lpBytesRead, lpTotalBytesAvail and lpBytesLeftThisMessage - your variables, after function call will be filled with values.
If lpTotalBytesAvail > 0 - there is some unread data in pipe.
Before calling to ReadFile check for new data in pipe.

Sample Listing:

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

Private Type STARTUPINFO
    cb As Long
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
    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 Type PIPE
    hReadPipe As Long
    hWritePipe As Long
End Type

Private Const INFINITE = -1&

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const CREATE_NEW_CONSOLE = &H10

Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESIZE = &H2
Private Const STARTF_USEPOSITION = &H4
Private Const STARTF_USECOUNTCHARS = &H8
Private Const STARTF_USEFILLATTRIBUTE = &H10
Private Const STARTF_RUNFULLSCREEN = &H20
Private Const STARTF_FORCEONFEEDBACK = &H40
Private Const STARTF_FORCEOFFFEEDBACK = &H80
Private Const STARTF_USESTDHANDLES = &H100

Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_NORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
Private Const SW_MAX = 10

Private Const INVALID_HANDLE_VALUE = -1

Private Const STILL_ACTIVE = &H103&

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 Declare Function WriteFile Lib "kernel32" _
 (ByVal hFile As Long, ByVal lpBuffer As String, _
 ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten _
 As Long, lpOverlapped As Any) As Long

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, ByVal lpEnvironment _
 As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo _
 As Any, lpProcessInformation As Any) As Long

Private Declare Function GetExitCodeProcess Lib _
 "kernel32" (ByVal hProcess As Long, lpExitCode _
 As Long) As Long
Private Declare Function TerminateProcess Lib _
 "kernel32" (ByVal hProcess As Long, ByVal uExitCode _
 As Long) As Long

Private Declare Function GetStdHandle Lib "kernel32" _
 (ByVal nStdHandle As Long) As Long
Private Declare Function SetStdHandle Lib "kernel32" _
 (ByVal nStdHandle As Long, ByVal nHandle As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
 (ByVal hObject 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 pipeOut As PIPE, pipeIn As PIPE

Private Process As PROCESS_INFORMATION

Private mvarCommandLine As String
Private mvarRunning As Boolean

Public Sub Terminate()
    TerminateProcess Process.hProcess, 0
    CloseHandle Process.hProcess
    CloseHandle Process.hThread
    CloseHandle pipeIn.hReadPipe
    CloseHandle pipeIn.hWritePipe
    CloseHandle pipeOut.hReadPipe
    CloseHandle pipeOut.hWritePipe
   
    mvarRunning = False
End Sub

Public Function Read(Optional ByVal Bytes As Long = -1)
                                                As String
    Dim tBytesR As Long, Buffer As String
    Dim tBytesA As Long, tMsg As Long
    Dim I As Long, Result As Long
    Dim ReturnStr As String
   
    If Not mvarRunning Then Exit Function
   
    Result = PeekNamedPipe(pipeErr.hReadPipe, ByVal 0&, 0, _
             tBytesR, tBytesA, tMsg)

    If Result <> 0 And tBytesA > 0 Then
        Buffer = String(tBytesA, " ")
        Result = ReadFile(pipeOut.hReadPipe, Buffer, _
                  IIf(Bytes = -1, Len(Buffer), _
            Bytes), tBytesR, ByVal 0&)
        If Result = 0 Then _
            Err.Raise vbObjectError + 504, "DOSShell Class", _
            "Error: ReadFile failed. " & Err.LastDllError
        ReturnStr = Left(Buffer, tBytesR)
        Read = DOSDecode(ReturnStr)
    End If
End Function

Public Function Write(ByVal Data As String) As Long
    Dim tBytesW As Long
    Dim I As Long, Result As Long

    If Not Right(Data, 2) = Chr(13) & Chr(10) Then _
             Data = Data & Chr(13) & Chr(10)

    Result = WriteFile(pipeIn.hWritePipe, Data, _
              Len(Data), tBytesW, ByVal 0&)
    If Result = 0 Then _
        Err.Raise 503, "DOSWrite", "Error: WriteFile failed. " _
                       & Err.LastDllError
    Result = FlushFileBuffers(pipe.hWritePipe)
    If Result = 0 Then _
        Err.Raise vbObjectError + 507, "DOSShell Class", _
         "Error: FlushFileBuffers failed. " & Err.LastDllError
   
    WriteIn = Len(Data) - 1
End Function

Public Function Execute(Optional ByVal CommandLine As _
           String = "") As Long
    Dim Result As Long
    Dim StartInfo As STARTUPINFO
    Dim Attribs As SECURITY_ATTRIBUTES
    Dim tIn As Long, tOut As Long
   
    On Error GoTo ErrHandler
   
    If CommandLine <> "" Then mvarCommandLine = CommandLine
   
    Attribs.nLength = Len(Attribs)
    Attribs.bInheritHandle = 1;
    Attribs.lpSecurityDescriptor = 0&
   
    Result = CreatePipe(pipeIn.hReadPipe, pipeIn.hWritePipe, _
 Attribs, ByVal 0&)
    If Result = 0 Then _
        Err.Raise vbObjectError + 501, "DOSShell Class", _
 "Error: CreatePipe failed. " & Err.LastDllError
   
    Result = CreatePipe(pipeOut.hReadPipe, pipeOut.hWritePipe, _
 Attribs, ByVal 0&)
    If Result = 0 Then _
        Err.Raise vbObjectError + 501, "DOSShell Class", _
 "Error: CreatePipe failed. " & Err.LastDllError
       
    StartInfo.cb = Len(StartInfo)
    StartInfo.hStdInput = pipeIn.hReadPipe
    StartInfo.hStdOutput = pipeOut.hWritePipe
    StartInfo.hStdError = pipeOut.hWritePipe
    StartInfo.dwFlags = STARTF_USESTDHANDLES + _
                              STARTF_USESHOWWINDOW
    StartInfo.wShowWindow = SW_HIDE

    Result = CreateProcess(0&, mvarCommandLine, Attribs, _
 Attribs, ByVal 1&, CREATE_NEW_CONSOLE, ByVal 0&, ByVal _
 0&, StartInfo, Process)
 
    If Result = 0 Then _
        Err.Raise vbObjectError + 502, "DOSShell Class", _
 "Error: CreateProcess failed. " & Err.LastDllError
   
    Execute = 1
    mvarRunning = True
    Exit Function

ErrHandler:
    Execute = Err.Number
   
End Function

Public Property Get Running() As Boolean
    Dim ExitCode As Long
    If Not mvarRunning Then
        Running = False
    Else
        GetExitCodeProcess Process.hProcess, ExitCode
        Running = (ExitCode = STILL_ACTIVE)
    End If
End Property

Public Property Let CommandLine(ByVal vData As String)
    mvarCommandLine = vData
End Property

Public Property Get CommandLine() As String
    CommandLine = mvarCommandLine
End Property

Private Function DOSDecode(ByVal Str As String) As String
    Dim I As Long

    For I = 239 To 192 Step -1
        Str = Replace(Str, Chr(I), Chr(I + 16))
    Next I

    For I = 191 To 128 Step -1
        Str = Replace(Str, Chr(I), Chr(I + 64))
    Next I
    Str = Replace(Str, Chr(0), "")

    DOSDecode = Str
End Function

0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now