VB.NET 同 Console 程序交互的方法

''' <summary>
''' 使用 .NET 自带的 Process 类可以启动外部 Console 程序并获取其输出，
''' 但 Process 类需要在外部程序结束后，才一次性返回外部程序的输出。
''' 
''' 如果想实现同外部程序的交互，Process 类无法满足要求，唯有采取自行
''' 使用 WINAPI 创建进程并关联自己管道的方法才能逐字符获取程序输出。
''' </summary>
''' <remarks>
''' 
''' 1 内部私有类 WINAPI 仅声明了所需的函数和结构及常数，并非完整 WINAPI
''' 里面的数据类型需要自己定义一下，例如 Zero、LPTSTR 要定义成 Int32
''' 相当于给系统内置的数据类型取个别名，在项目属性的“引用”页添加
''' 
''' 
''' 2 使用指南
''' 
''' 2.1 首先需要 objname = New CPLINK( _in_exepath,_in_opt_encoding) 创建一个对象实例
''' 
''' 2.1.1 参数 exepath 必须是完整的绝对路径，必须是 Console 程序
''' 
''' 2.1.2 参数 encoding 可选，是同外部程序交互时使用的编码，如果省略则为 UTF8
''' 
''' 2.2 可以用 PlinkStart(命令行字符串) 启动程序
''' 并通过公共成员 CStdout,CStderr As StreamReader 读取外部程序的输出
''' 并通过公共成员 CStdin As StreamWriter 发送内容给外部程序
''' 
''' 2.3 可以用 PlinkStartWithEvents(命令行字符串) 启动程序
''' 然后侦听事件 E_PlinkOutRecieved(data As String,channel As Integer,iscompleteline As Boolean) 获得输出
''' 
''' 2.3.1 事件参数 data 是不含回车换行的一行文本
''' 
''' 2.3.2 事件参数 channel 为数字：1 表示来自于外部程序 stdout 的输出；2 表示来自 stderr 的输出
''' 
''' 2.3.3 事件参数 iscompleteline 为 True 表示因为收到了回车换行符而输出数据行，
''' 为 False 表示是因读取超时而输出已收到的数据；
''' 超时的具体值可以用公共成员 ReadTimeout_ms 来设置，缺省值是 75 毫秒；
''' 经实测，大于这个值在实时交互中字符回显会产生可以察觉的延迟，给用户带来不愉感
''' 
''' </remarks>


Public Class CPLINK
#Region "WINAPI定义"
    Private Class WINAPI
        <System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Sequential)> _
        Private Structure STARTUPINFO
            Dim cb As DWORD
            Dim lpReserved As LPTSTR
            Dim lpDesktop As LPTSTR
            Dim lpTitle As LPTSTR
            Dim dwX As DWORD
            Dim dwY As DWORD
            Dim dwXSize As DWORD
            Dim dwYSize As DWORD
            Dim dwXCountChars As DWORD
            Dim dwYCountChars As DWORD
            Dim dwFillAttribute As DWORD
            Dim dwFlags As DWORD
            Dim wShowWindow As WORD
            Dim cbReserved2 As WORD
            Dim lpReserved2 As LPBYTE
            Dim hStdInput As HANDLE
            Dim hStdOutput As HANDLE
            Dim hStdError As HANDLE
        End Structure

        <System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Sequential)> _
        Private Structure PROCESS_informatION
            Dim hProcess As HANDLE
            Dim hThread As HANDLE
            Dim dwProcessId As DWORD
            Dim dwThreadId As DWORD
        End Structure

        Private Declare Unicode Function _CreateProcess Lib "Kernel32.dll" Alias "CreateProcessW" (ByVal _in_ApplicationName As String,ByVal _inout_CommandLine As String,ByVal _opt_lpProcessAttributes As Zero,ByVal _opt_lpThreadAttributes As Zero,ByVal _in_InheritHandles As BOOL,ByVal _in_CreationFlags As DWORD,ByVal _opt_lpEnvironment As Zero,ByVal _opt_lpCurrentDirectory As Zero,ByRef _in_StartupInfo As STARTUPINFO,ByRef _out_Processinformation As PROCESS_informatION) As BOOL
        Private Declare Auto Function _GetLastError Lib "Kernel32.dll" Alias "GetLastError" () As DWORD

        Private Const STARTF_USESTDHANDLES As DWORD = &H100
        Private Const CREATE_NO_WINDOW As DWORD = &H8000000
        Private Const CREATE_NEW_CONSOLE As DWORD = &H10
        Private Const [TRUE] As DWORD = 1

        Public Shared Function CreateProcess(AppPath As String,Arguements As String,hStdin As Microsoft.Win32.SafeHandles.SafePipeHandle,hStdout As Microsoft.Win32.SafeHandles.SafePipeHandle,hStderr As Microsoft.Win32.SafeHandles.SafePipeHandle) As Integer
            Dim si As New STARTUPINFO
            Dim pi As New PROCESS_informatION
            si.cb = Len(si)

#If 不用特别调试 = True Then
            si.hStdInput = 0 ' hStdin.DangerousGetHandle
            si.hStdOutput = hStdout.DangerousGetHandle
            si.hStdError = hStderr.DangerousGetHandle
            si.dwFlags = STARTF_USESTDHANDLES
            If 0 = _CreateProcess(AppPath,"appname.exe " & Arguements,0,[TRUE],CREATE_NEW_CONSOLE,si,pi) Then
#Else
            si.hStdInput = hStdin.DangerousGetHandle
            si.hStdOutput = hStdout.DangerousGetHandle
            si.hStdError = hStderr.DangerousGetHandle
            si.dwFlags = STARTF_USESTDHANDLES
            If 0 = _CreateProcess(AppPath,"plink.exe " & Arguements,CREATE_NO_WINDOW,pi) Then
#End If
                Dim errcode As Integer = _GetLastError()
                MsgBox("CreateProcess Failed and lasterror code is: " & errcode)
                Return 0
            Else
                Return pi.dwProcessId
            End If
        End Function

    End Class
#End Region

#Region "工作区"
    Private plinkPath As String,plinkEncoding As System.Text.Encoding
    Private plnkCStdin,plnkCStdout,plnkCStderr As System.IO.Pipes.AnonymousPipeServerStream
    Private plnkProcessID As Integer,thRdCStdout,thRdCstderr As System.Threading.Thread
    Private rtaa(2) As ReadThreadArgs '管道专读线程参数数组(0 to 2)，但0不用，因为 0|1|2 在习惯上代表 stdin|stdout|stderr。

    Public CStdin As System.IO.StreamWriter,CStdout,CStderr As System.IO.StreamReader
    Public ReadTimeout_ms As Integer = 75

    Private Event E_CharRecieved(ch As Char,channel As Integer) '处理字符到达的内部事件
    Public Event E_PlinkOutRecieved(data As String,iscompleteline As Boolean)

    Private Structure ReadThreadArgs
        Dim sr As System.IO.StreamReader
        Dim channel As Integer
        Dim strb As System.Text.StringBuilder
        Dim rdTimer As System.Timers.Timer
    End Structure
    Private Sub ReadThreadMain(rta As ReadThreadArgs)
        Dim ch As Char
        Do
            Try
                ch = ChrW(rta.sr.Read())
                RaiseEvent E_CharRecieved(ch,rta.channel)
            Catch ex As Exception
                Exit Do
            End Try
        Loop
    End Sub
    Public Function PlinkStartWithEvents(argline As String) As Boolean
        If Not PlinkStart(argline) Then Return False

        thRdCstderr = New System.Threading.Thread(AddressOf ReadThreadMain)
        thRdCStdout = New System.Threading.Thread(AddressOf ReadThreadMain)
        thRdCstderr.IsBackground = True
        thRdCStdout.IsBackground = True
        rtaa(2) = New ReadThreadArgs With {.sr = CStderr,.channel = 2,.strb = New System.Text.StringBuilder,.rdTimer = New System.Timers.Timer With {.Interval = ReadTimeout_ms}}
        rtaa(1) = New ReadThreadArgs With {.sr = CStdout,.channel = 1,.rdTimer = New System.Timers.Timer With {.Interval = ReadTimeout_ms}}

        AddHandler rtaa(2).rdTimer.Elapsed,AddressOf OnTimeOut_channel2
        AddHandler rtaa(1).rdTimer.Elapsed,AddressOf OnTimeOut_channel1

        thRdCstderr.Start(rtaa(2))
        thRdCStdout.Start(rtaa(1))
        Return True
    End Function
    Private Sub OnTimeOut_channel2(sender As Object,e As System.Timers.ElapsedEventArgs)
        Call WhenTimeOut(2)
    End Sub
    Private Sub OnTimeOut_channel1(sender As Object,e As System.Timers.ElapsedEventArgs)
        Call WhenTimeOut(1)
    End Sub
    Private Sub WhenTimeOut(channel As Integer)
        With rtaa(channel)
            .rdTimer.Enabled = False
            If .strb.Length > 0 Then
                RaiseEvent E_PlinkOutRecieved(.strb.ToString,channel,False)
                .strb.Clear()
            End If
        End With
    End Sub
    Private Sub OnCharRecieved(ch As Char,channel As Integer) Handles Me.E_CharRecieved
        Dim chCode As Integer = AscW(ch)
        Dim te As Boolean = True
        With rtaa(channel)
            .rdTimer.Enabled = False

            Select Case chCode
                Case 13
                    '.strb.Append("\x0D")
                Case 10
                    '.strb.Append("\x0A")
                    RaiseEvent E_PlinkOutRecieved(.strb.ToString,True)
                    .strb.Clear()
                    te = False
                Case &H1 To &HF
                    .strb.Append("\x0" & Hex(chCode))
                Case &H10 To &H1F,&H7F
                    .strb.Append("\x" & Hex(chCode))
                Case Else
                    .strb.Append(ch)
            End Select
            .rdTimer.Enabled = te
        End With
    End Sub

    Public Function PlinkStart(argline As String) As Boolean
        Try
            plnkCStderr = New System.IO.Pipes.AnonymousPipeServerStream(IO.Pipes.PipeDirection.In,IO.HandleInheritability.Inheritable)
            plnkCStdout = New System.IO.Pipes.AnonymousPipeServerStream(IO.Pipes.PipeDirection.In,IO.HandleInheritability.Inheritable)
            plnkCStdin = New System.IO.Pipes.AnonymousPipeServerStream(IO.Pipes.PipeDirection.Out,IO.HandleInheritability.Inheritable)

            CStderr = New System.IO.StreamReader(plnkCStderr,plinkEncoding)
            CStdout = New System.IO.StreamReader(plnkCStdout,plinkEncoding)
            CStdin = New System.IO.StreamWriter(plnkCStdin,plinkEncoding) : CStdin.AutoFlush = True

            plnkProcessID = WINAPI.CreateProcess(plinkPath,argline,plnkCStdin.ClientSafePipeHandle,plnkCStdout.ClientSafePipeHandle,plnkCStderr.ClientSafePipeHandle)

            Return CBool(plnkProcessID)
        Catch ex As Exception
            MsgBox("EXCEPTION@CPLINK::Start: " & ex.Message)
            Return False
        End Try
    End Function
    Public Sub PlinkEnd()
        Try
            Dim pp As Process = System.Diagnostics.Process.GetProcessById(plnkProcessID)
            pp.Kill()
        Catch ex As Exception
        End Try
        Try
            CStderr.Close()
            CStdin.Close()
            CStdout.Close()
        Catch ex As Exception
        End Try
        Try
            plnkCStderr.Close()
            plnkCStdin.Close()
            plnkCStdout.Close()
        Catch ex As Exception
        End Try
    End Sub

    Sub New(in_plinkpath As String,Optional in_encoding As System.Text.Encoding = nothing)
        If System.IO.File.Exists(in_plinkpath) Then
            plinkPath = in_plinkpath
            If in_encoding Is nothing Then
                plinkEncoding = System.Text.Encoding.UTF8
            Else
                plinkEncoding = in_encoding
            End If
        Else
            Throw New Exception("Failed@CPLINK::New: 指定的文件【" & in_plinkpath & "】不存在")
        End If
    End Sub

    Protected Overrides Sub Finalize()
        MyBase.Finalize()
        Me.PlinkEnd()
    End Sub

#End Region

End Class