Solved

Using pipes (VB6) to communicate with a console App.

Posted on 2004-03-29
12
2,578 Views
Last Modified: 2007-12-19
Basically, I'm trying to create a class that can communicate silently with console apps (specifically so I can uitilize the "crafty" AI for a chess game, but that's not the point.)

Thus far, I'm able to create the pipe, create the process, and "read" the data from the process.  The problem here is that the app seems to "lock up" whenever the process is waiting for user input.  For instance:

During the boot-up sequence to Crafty, I get this:

*------------------------
EPD Kit revision date: 1996.04.21
unable to open book file [./book.bin].
book is disabled
unable to open book file [./books.bin].

Crafty v19.3 (1 cpus)
*------------------------


When I SHOULD be getting this:
*------------------------
EPD Kit revision date: 1996.04.21
unable to open book file [./book.bin].
book is disabled
unable to open book file [./books.bin].

Crafty v19.3 (1 cpus)

White(1):
*------------------------


Note that the "White(1):" is the prefix where it's awaiting input.  I NEED to be able to find out what that line actually says, so I know WHAT kind of input I'm trying to give it.  However, if I try to do another ReadFile() call, the whole IDE locks up as it's waiting for the console app to give it another response.  I still haven't gotten the "write" function to work for me at all.  

Please, as you can see, I've done my homework on this one.  If you don't have an actual answer, don't send me links to the 100 microsoft/mentalis/pscode/etc. websites that I've already seen.

The following is the code I'm using for the console class.

*------------------------
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 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 WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten 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 secPipe As SECURITY_ATTRIBUTES
Private secProcess As SECURITY_ATTRIBUTES
Private secThread As SECURITY_ATTRIBUTES
Private infProcess As PROCESS_INFORMATION
Private suiProcess As STARTUPINFO
Private lngRead As Long
Private lngWrite As Long

Public Function Initialize(ByVal CmdLine As String) As Long
    secPipe.nLength = Len(secPipe)
    secPipe.lpSecurityDescriptor = 0
    secPipe.bInheritHandle = True
   
    'First fire up the pipe that the input/output will pass across.  This will
    'give us the pointers for the Read/Write if all goes well.
    Initialize = CreatePipe(lngRead, lngWrite, secPipe, Len(secPipe))
    If Initialize = 0 Then Exit Function
   
    'So far, the pipe seems to be working, so it's time to build the process.
    'Keep in mind that you ALSO need a "thread" for the process to run on, so
    'that also needs to be defined.
    secProcess.nLength = Len(secProcess)
    secThread.nLength = Len(secThread)
   
    'This is the "StartUpInfo" for the process.
    suiProcess.cb = Len(suiProcess)
   
    'This fills the suiProcess with the same startup information that was used
    'to start up THIS application, making sure they're compatible.
    GetStartupInfo suiProcess
   
    'Tells it where the pipe is that it's supposed to talk through.
    suiProcess.hStdOutput = lngWrite
    suiProcess.hStdError = lngWrite
   
    'USESHOWWINDOW allows us to use SW_HIDE to hide the process.  USESTDHANDLES allows us
    'to use the lngRead and lngWrite handles (assigned above).
    suiProcess.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
    suiProcess.wShowWindow = SW_HIDE

    'Microsoft says to set these to these values before creating the process.
    suiProcess.lpReserved = vbNull
    suiProcess.lpReserved2 = vbNull
    suiProcess.cbReserved2 = 0

    'Now we actually create the "process" firing up the app.
    Initialize = CreateProcess(vbNullString, CmdLine, secProcess, secThread, True, 0, Null, vbNullString, suiProcess, infProcess)
    If Initialize = 0 Then Exit Function

End Function

Public Function ReadData(ByRef Data As String) As Long
    Dim bytBuffer(30001) As Byte, lngBytesRead As Long, lngCount As Long
    Data = ""
    ReadData = ReadFile(lngRead, bytBuffer(0), 30000, lngBytesRead, ByVal 0&)
    If ReadData = 0 Then Exit Function
    For lngCount = 0 To lngBytesRead
        Data = Data & Chr$(bytBuffer(lngCount))
    Next lngCount
    DoEvents
End Function

Public Function WriteData(ByVal Data As String) As Long
    Dim bytBuffer() As Byte, lngCount As Long, lngBytesWritten As Long
    ReDim bytBuffer(Len(Data))
    For lngCount = 1 To Len(Data)
        bytBuffer(lngCount - 1) = Asc(Mid$(Data, lngCount, 1))
    Next lngCount
    WriteData = WriteFile(lngWrite, bytBuffer(0), Len(Data) - 1, lngBytesWritten, ByVal 0&)
End Function
Private Sub Class_Terminate()
    'Close down the thread, then process.
    CloseHandle infProcess.hThread
    CloseHandle infProcess.hProcess
    'Then close down the read/write pipes.
    CloseHandle lngRead
    CloseHandle lngWrite
End Sub
*------------------------
0
Comment
Question by:Javin007
  • 7
  • 4
12 Comments
 
LVL 4

Expert Comment

by:sokolovsky
ID: 10711601
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
 
LVL 26

Expert Comment

by:EDDYKT
ID: 10714049
0
 
LVL 4

Author Comment

by:Javin007
ID: 10714058
Can't seem to get this to work.  Tried plugging this in to replace my own class, but it throws an error on read.  The PipeERR object is in the Read function, but that's the only place it shows up.  It's not declared anywhere.

As far as I can tell, the "PeekNamedPipe" is KIND of what I'm looking for, in that it'll retrieve the data in the pipe without "flushing" it causing the lockups I get with my own code.  I'll try implementing that with my own class and seeing if it returns the "White(1):" like I need.  

Another problem I'm having is that the process aren't properly being released (i.e., they're still running in the background and must be shut down with the task manager.)

If you can comment this similarly to how I've commented my own code to make it a bit easier to understand, I've got another 500 points on this same question for ya.

-Javin
0
 
LVL 4

Author Comment

by:Javin007
ID: 10714105
Another thing I noticed that you were doing:

*-----------------------------------------------------------
    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
*-----------------------------------------------------------

I see that you're creating two identical pipes, one specifically for reading, the other for writing.  Is it not possible to use a single pipe to do both?
0
 
LVL 4

Accepted Solution

by:
sokolovsky earned 500 total points
ID: 10714503
Sorry, my fault.
Here is the code. It is working.
Look at my class clsPIPE.

Form "frmPipe" with command button "Command1" and multiline textbox "Text1"
----------------- Start of frmPipe.frm -----------------
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim objPipe As clsPipe
Private Sub Command1_Click()
    Call objPipe.Execute("CMD.EXE")
    Call Sleep(100)
    Text1.Text = objPipe.Read
    Call objPipe.Write_("time" & vbCrLf)
    Call Sleep(100)
    Text1.Text = Text1.Text & objPipe.Read
End Sub
Private Sub Form_Load()
    Set objPipe = New clsPipe
End Sub
Private Sub Form_Unload(Cancel As Integer)
    If objPipe.Running = True Then
        Call objPipe.Terminate
    End If
    Set objPipe = Nothing
End Sub
----------------- End of frmPipe.frm ------------------

----------------- Start of clsPipe.cls --------------------
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(pipeOut.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
    If Result = 0 Then Err.Raise vbObjectError + 507, "DOSShell Class", "Error: FlushFileBuffers failed. " & Err.LastDllError
    Write_ = 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_SHOWNORMAL 'SW_HIDE
    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
----------------- End of clsPipe.cls --------------------
0
 
LVL 4

Author Comment

by:Javin007
ID: 10714685
Okay, played with the way you did it, and massaged it into my own code, and the read seems to be working fine (haven't gotten to the writing yet.)  It DOES give me the necessary Write(1): data.  Thanks for the PeekNamedPipe API.  (And the TerminateProcess).  The problem is, this still doesn't let me know when the console app is waiting for input.  It just lets me know that nothing else is trying to be read.  Is there any way to find out when the app is waiting for input?

-Javin
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
LVL 4

Author Comment

by:Javin007
ID: 10714710
Here's what I've got so far:

*--------------------------------------------------------------------------
'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 ReadData(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)
        ReadData = DOSDecode(ReturnStr)
    End If
End Function

Public Function WriteData(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
 
LVL 4

Author Comment

by:Javin007
ID: 10714836
Okay, seem to have everything working BUT the ability to tell when the console app is waiting for input.  If you have a way to check and see when it's waiting for input, we can close this one up!  

-Javin
0
 
LVL 4

Author Comment

by:Javin007
ID: 10715490
(The reasoning behind this is because Crafty can take anywhere from .1 seconds to 20 minutes to generate a response and be ready for your next input statement. I'll need to know when it's ready for input.)

-Javin
0
 
LVL 4

Expert Comment

by:sokolovsky
ID: 10716268
As far as i know, there is no general way to tell when the console app is waiting for input.

My idea is simple:
1) Define some string (char sequence)
Const strReadForInput = ":>"
2) When Crafty is ready for input, this program(Crafty) writes this string (":>")
3) In your program:
Dim strText as string
strText = objPipe.ReadData
If instr(1,strText,strReadForInput)>0 then
 'Crafty is ready for input!
End If

P.S. There is a way to signal, when the input buffer of Crafty becomes empty. You can write new data to Crafty as soon, as input buffer become empty. But i'm not sure about this method.
"A thread of an application's process can perform a wait operation to wait for input to be available in an input buffer. To initiate a wait operation, specify a handle to the input buffer in a call to any of the wait functions. These functions can return when the state of one or more objects is signaled. The state of a console input handle becomes signaled when there are unread records in its input buffer. (!>) The state is reset to nonsignaled when the input buffer becomes empty(<!) . If there is no input available, the calling thread enters an efficient wait state, consuming very little processor time while waiting for the conditions of the wait operation to be satisfied."  
0
 
LVL 4

Author Comment

by:Javin007
ID: 10716933
Hrm.  For some reason, I lost my last post.

Basically, I said that I was afraid you were going to say that, because Crafty isn't that friendly.  :/

Here's the other post.  Post in here to get these points as well:
http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_20889643.html
0
 
LVL 4

Expert Comment

by:sokolovsky
ID: 10721474
:)
Ok, i'll post there.
0

Featured Post

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!

Join & Write a Comment

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

705 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

20 Experts available now in Live!

Get 1:1 Help Now