Question

我需要定期为基于表单的应用程序检查stdin输入，但仍然执行其他处理。 Scripting.TextStream.Read（）和ReadFile（）API是阻塞的，是否有一种在VB6中读取stdin的非阻塞方法？

每隔100毫秒设置Timer1，我就试过了：

Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long

Dim sin As Scripting.TextStream

Private Sub Form_Load()

    AllocConsole

    Dim FSO As New Scripting.FileSystemObject
    Set sin = FSO.GetStandardStream(StdIn)

    Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()

    Dim cmd As String
    While Not sin.AtEndOfStream
        cmd = sin.Read(1)
        Select Case cmd

            ' Case statements to process each byte read...

        End Select
    Wend

End Sub

我也试过了：

Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function ReadFileA Lib "kernel32" Alias "ReadFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const STD_INPUT_HANDLE = -10&

Dim hStdIn As Long

Private Sub Form_Load()

    AllocConsole

    hStdIn = GetStdHandle(STD_INPUT_HANDLE)

    Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()

    Dim bytesRead as Long
    Dim cmd As String
    cmd = Space$(16)
    cmd = ReadFile(hStdIn, ByVal cmd, Len(cmd), bytesRead, ByVal 0&)

    ' Statements to process each Line read...

End Sub

我也尝试过ReadConsole（）API，它们都会阻止。

Answer 1

我担心到目前为止我还没有设法让这个工作，但是其他人也许可以去。想法是使用带有控制台标准输入的异步I / O（我假设您的应用程序的想法是允许人们直接写入控制台窗口，并在输入时读取输入。）

我将所有API内容分离到一个模块（MAsynchConsole）中：

Option Explicit

Private Const GENERIC_READ          As Long = &H80000000
Private Const GENERIC_WRITE         As Long = &H40000000
Private Const OPEN_EXISTING         As Long = 3&
Private Const FILE_FLAG_OVERLAPPED  As Long = &H40000000
Private Const FILE_SHARE_READ       As Long = &H1

Private Const FILE_FLAG_NO_BUFFERING As Long = &H20000000

Private Type OVERLAPPED
    Internal                    As Long
    InternalHigh                As Long
    OffsetOrPointer             As Long
    OffsetHigh                  As Long
    hEvent                      As Long
End Type

Private Type OVERLAPPED_ENTRY
    lpCompletionKey             As Long
    lpOverlapped                As Long ' pointer to OVERLAPPED
    Internal                    As Long
    dwNumberOfBytesTransferred  As Long
End Type

Private Declare Function AllocConsole Lib "kernel32" () As Long

Private Declare Function CancelIo Lib "Kernel32.dll" ( _
    ByVal hFile As Long _
) As Long

Private Declare Function CreateFile Lib "Kernel32.dll" Alias "CreateFileW" ( _
    ByVal lpFileName As Long, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareModen As Long, _
    ByRef lpSecurityAttributes As Any, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long _
) As Long

Private Declare Function FreeConsole Lib "kernel32" () As Long

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


Private Declare Function ReadFile Lib "Kernel32.dll" ( _
    ByVal hFile As Long, _
    ByVal lpBuffer As Long, _
    ByVal nNumberOfBytesToRead As Long, _
    ByRef lpNumberOfBytesRead As Long, _
    ByRef lpOverlapped As OVERLAPPED _
) As Long

Private Declare Function ReadFileEx Lib "Kernel32.dll" ( _
    ByVal hFile As Long, _
    ByVal lpBuffer As Long, _
    ByVal nNumberOfBytesToRead As Long, _
    ByRef lpOverlapped As OVERLAPPED, _
    ByVal lpCompletionRoutine As Long _
) As Long

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

Private m_hStdIn                    As Long
Private m_uOverlapped               As OVERLAPPED
Private m_sUnicodeBuffer            As String

Private m_oReadCallback             As IReadCallback

Public Sub CloseConsole()

    CancelIo m_hStdIn
    Set m_oReadCallback = Nothing
    m_sUnicodeBuffer = vbNullString
    CloseHandle m_hStdIn

    FreeConsole

End Sub

Private Sub FileIOCompletionRoutine( _
    ByVal dwErrorCode As Long, _
    ByVal dwNumberOfBytesTransfered As Long, _
    ByRef uOverlapped As OVERLAPPED _
)

    On Error GoTo ErrorHandler

    m_oReadCallback.DataRead "FileIOCompletionRoutine"
    m_oReadCallback.DataRead "dwErrorCode = " & CStr(dwErrorCode)

    If dwErrorCode Then
        MsgBox "Error = " & CStr(dwErrorCode)
        CloseConsole
        Exit Sub
    End If

    m_oReadCallback.DataRead "dwNumberOfBytesTransfered = " & CStr(dwNumberOfBytesTransfered)

    m_oReadCallback.DataRead Left$(m_sUnicodeBuffer, dwNumberOfBytesTransfered)

Exit Sub

ErrorHandler:
    '
End Sub

Public Sub OpenConsoleForInput(ByRef the_oReadCallback As IReadCallback)

    Dim sFileName                   As String

    On Error GoTo ErrorHandler

    Set m_oReadCallback = the_oReadCallback

    AllocConsole

    'm_hStdIn = GetStdHandle(-10&)

    sFileName = "CONIN$"
    'm_hStdIn = CreateFile(StrPtr(sFileName), GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING,  0&, 0&)
    m_hStdIn = CreateFile(StrPtr(sFileName), GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0&)

    m_oReadCallback.DataRead "m_hStdIn = " & CStr(m_hStdIn)
    m_oReadCallback.DataRead "LastError = " & CStr(Err.LastDllError)

    m_sUnicodeBuffer = Space$(8192)

Exit Sub

ErrorHandler:
    Err.Raise Err.Number, Err.Source, Err.Description
End Sub

Public Sub Read()

    Dim nRet                            As Long
    Dim nBytesRead                      As Long

    On Error GoTo ErrorHandler

    m_oReadCallback.DataRead "About to call ReadFileExe"

    'm_uOverlapped.OffsetHigh = 0&
    'm_uOverlapped.OffsetOrPointer = 0&
    'nRet = ReadFile(m_hStdIn, StrPtr(m_sUnicodeBuffer), LenB(m_sUnicodeBuffer), nBytesRead, m_uOverlapped)
    nRet = ReadFileEx(m_hStdIn, StrPtr(m_sUnicodeBuffer), LenB(m_sUnicodeBuffer), m_uOverlapped, AddressOf FileIOCompletionRoutine)

    m_oReadCallback.DataRead "nRet = " & CStr(nRet)

    m_oReadCallback.DataRead "nBytesRead = " & CStr(nBytesRead)

    If nRet = 0 Then
        m_oReadCallback.DataRead "Err.LastDllError = " & CStr(Err.LastDllError)
    Else
        m_oReadCallback.DataRead StrConv(Left$(m_sUnicodeBuffer, nBytesRead), vbUnicode)
    End If

Exit Sub

ErrorHandler:
    Err.Raise Err.Number, Err.Source, Err.Description
End Sub

这依赖于一个接口（IReadCallback）与主GUI进行通信。

Option Explicit

Public Sub DataRead(ByRef out_sData As String)
    '
End Sub

这是我的示例表单（FAsynchConsoleTest） - 它使用Timer（Timer）和RichTextBox（txtStdIn）：

Option Explicit

Implements IReadCallback

Private Sub Form_Load()

    MAsynchConsole.OpenConsoleForInput Me

    Timer.Enabled = True

End Sub

Private Sub Form_Unload(Cancel As Integer)

    MAsynchConsole.CloseConsole

End Sub

Private Sub IReadCallback_DataRead(out_sData As String)

    txtStdIn.SelStart = Len(txtStdIn.Text)
    txtStdIn.SelText = vbNewLine & out_sData

End Sub

Private Sub mnuTimerOff_Click()

    Timer.Enabled = False

End Sub

Private Sub mnuTimerOn_Click()

    Timer.Enabled = True

End Sub

Private Sub Timer_Timer()

    MAsynchConsole.Read

End Sub

不幸的是，虽然使用FILE_FLAG_OVERLAPPED的CreateFile（）应该创建一个可以与异步I / O一起使用的文件句柄，并且句柄似乎有效，ReadFileEx（）返回0，GetLastError为6，即：

//
// MessageId: ERROR_INVALID_HANDLE
//
// MessageText:
//
// The handle is invalid.
//
#define ERROR_INVALID_HANDLE             6L

有趣的是，控制台被冷冻，而这一切都发生了。

其他人有什么想法吗？文档似乎暗示如果您将CreateFile（）与控制台设备名称一起使用，则会忽略该参数。

Answer 2

使用vbAdvance加载项编译以下示例并选中“Build As Console Application”选项。

Option Explicit

'--- for GetStdHandle
Private Const STD_INPUT_HANDLE          As Long = -10&
Private Const STD_OUTPUT_HANDLE         As Long = -11&
'--- for PeekConsoleInput
Private Const KEY_EVENT                 As Long = 1
'--- for GetFileType
Private Const FILE_TYPE_PIPE            As Long = &H3
Private Const FILE_TYPE_DISK            As Long = &H1

Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function GetConsoleMode Lib "kernel32" (ByVal hConsoleHandle As Long, lpMode As Long) As Long
Private Declare Function SetConsoleMode Lib "kernel32" (ByVal hConsoleHandle As Long, ByVal dwMode As Long) As Long
Private Declare Function PeekNamedPipe Lib "kernel32" (ByVal hNamedPipe As Long, lpBuffer As Any, ByVal nBufferSize As Long, ByVal lpBytesRead As Long, lpTotalBytesAvail As Long, ByVal lpBytesLeftThisMessage As Long) 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 OemToCharBuff Lib "user32" Alias "OemToCharBuffA" (ByVal lpszSrc As String, ByVal lpszDst As String, ByVal cchDstLength As Long) 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 CharToOemBuff Lib "user32" Alias "CharToOemBuffA" (ByVal lpszSrc As String, lpszDst As Any, ByVal cchDstLength As Long) As Long
Private Declare Function PeekConsoleInput Lib "kernel32" Alias "PeekConsoleInputA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nLength As Long, lpNumberOfEventsRead As Long) As Long
Private Declare Function ReadConsoleInput Lib "kernel32" Alias "ReadConsoleInputA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nLength As Long, lpNumberOfEventsRead As Long) As Long
Private Declare Function GetFileType Lib "kernel32" (ByVal hFile As Long) As Long

Sub Main()
    Dim hStdIn          As Long
    Dim sBuffer         As String
    Dim dblTimer        As Double

    hStdIn = GetStdHandle(STD_INPUT_HANDLE)
    Do
        sBuffer = sBuffer & ConsoleReadAvailable(hStdIn)
        If dblTimer + 1 < Timer Then
            dblTimer = Timer
            Call OemToCharBuff(sBuffer, sBuffer, Len(sBuffer))
            ConsolePrint "%1: %2" & vbCrLf, Format$(Timer, "0.00"), sBuffer
            sBuffer = vbNullString
        End If
    Loop
End Sub

Private Function ConsoleReadAvailable(ByVal hStdIn As Long) As String
    Dim lType           As Long
    Dim sBuffer         As String
    Dim lChars          As Long
    Dim lMode           As Long
    Dim lAvailChars     As Long
    Dim baBuffer(0 To 512) As Byte
    Dim lEvents         As Long

    lType = GetFileType(hStdIn)
    If lType = FILE_TYPE_PIPE Then
        If PeekNamedPipe(hStdIn, ByVal 0, 0, 0, lAvailChars, 0) = 0 Then
            Exit Function
        End If
    End If
    If lType = FILE_TYPE_DISK Or lAvailChars > 0 Then
        sBuffer = Space(IIf(lAvailChars > 0, lAvailChars, 512))
        Call ReadFile(hStdIn, ByVal sBuffer, Len(sBuffer), lChars, 0)
        ConsoleReadAvailable = Left$(sBuffer, lChars)
    End If
    If GetConsoleMode(hStdIn, lMode) <> 0 Then
        Call SetConsoleMode(hStdIn, 0)
        Do While PeekConsoleInput(hStdIn, baBuffer(0), 1, lEvents) <> 0
            If lEvents = 0 Then
                Exit Do
            End If
            If baBuffer(0) = KEY_EVENT And baBuffer(4) <> 0 Then ' baBuffer(4) = INPUT_RECORD.bKeyDown
                sBuffer = Space(1)
                Call ReadFile(hStdIn, ByVal sBuffer, Len(sBuffer), lChars, 0)
                ConsoleReadAvailable = ConsoleReadAvailable & Left$(sBuffer, lChars)
            Else
                Call ReadConsoleInput(hStdIn, baBuffer(0), 1, lEvents)
            End If
        Loop
        Call SetConsoleMode(hStdIn, lMode)
    End If
End Function

Public Function ConsolePrint(ByVal sText As String, ParamArray A() As Variant) As String
'    Const FUNC_NAME     As String = "ConsolePrint"
    Dim lI              As Long
    Dim sArg            As String
    Dim baBuffer()      As Byte
    Dim dwDummy         As Long

    '--- format
    For lI = UBound(A) To LBound(A) Step -1
        sArg = Replace(A(lI), "%", ChrW$(&H101))
        sText = Replace(sText, "%" & (lI - LBound(A) + 1), sArg)
    Next
    ConsolePrint = Replace(sText, ChrW$(&H101), "%")
    '--- output
    ReDim baBuffer(1 To Len(ConsolePrint)) As Byte
    If CharToOemBuff(ConsolePrint, baBuffer(1), UBound(baBuffer)) Then
        Call WriteFile(GetStdHandle(STD_OUTPUT_HANDLE), baBuffer(1), UBound(baBuffer), dwDummy, ByVal 0&)
    End If
End Function

Answer 3

wqw的答案对基于表单的应用程序不起作用，但Peek / ReadConsoleInput给出的原型允许使用以下内容：

Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function PeekConsoleInput Lib "kernel32" Alias "PeekConsoleInputA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nLength As Long, lpNumberOfEventsRead As Long) As Long
Private Declare Function ReadConsoleInput Lib "kernel32" Alias "ReadConsoleInputA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nLength As Long, lpNumberOfEventsRead As Long) 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 SetConsoleMode Lib "kernel32" (ByVal hConsoleInput As Long, dwMode As Long) As Long

Private Const STD_INPUT_HANDLE As Long = -10& ' GetStdHandle()

Private Const KEY_EVENT As Long = 1 ' PeekConsoleInput()

Private Const ENABLE_PROCESSED_INPUT As Long = &H1 ' SetConsoleMode()
Private Const ENABLE_ECHO_INPUT As Long = &H4

Dim hStdIn As Long

Private Sub Form_Load()

    AllocConsole

    hStdIn = GetStdHandle(STD_INPUT_HANDLE)
    SetConsoleMode hStdIn, ENABLE_PROCESSED_INPUT ' Or ENABLE_ECHO_INPUT ' uncomment to see the characters typed (for debugging)

    Timer1.Enabled = True

    Exit Sub

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    CloseHandle hStdIn
    FreeConsole

End Sub

Private Sub Timer1_Timer()

    Dim bytesRead As Long
    Dim buffer As String
    Dim baBuffer(0 To 512) As Byte
    Dim lEvents As Long

    PeekConsoleInput hStdIn, baBuffer(0), 1, lEvents
    If lEvents > 0 Then
        If baBuffer(0) = KEY_EVENT And baBuffer(4) <> 0 Then ' baBuffer(4) = INPUT_RECORD.bKeyDown
            buffer = Space$(1)
            Call ReadFile(hStdIn, ByVal buffer, Len(buffer), bytesRead, 0)

            ' buffer now contains one byte read from console
            ' Statements to process go here.

        Else
            Call ReadConsoleInput(hStdIn, baBuffer(0), 1, lEvents)
        End If
    End If
End Sub

如果您的应用程序不是真正的VB6控制台应用程序，那么PeekNamedPipe，GetConsoleMode和PeekConsoleInput都将返回零（尽管所有可能需要的是与控制台子系统链接，例如，"C:\Program Files\Microsoft Visual Studio\vb98\LINK.EXE" /EDIT /SUBSYSTEM:CONSOLE MyApp.exe，我还没有测试过它那么远）。然而，他们仍然有效，至少是Peek ......的确如此。

关键是每次传递只读取一个字节，因为读取baBuffer中的内容在第一个记录（INPUT_RECORD结构）之后是有问题的，但是一次一个字节非阻塞优于无阻塞。对我来说，Timer1设置为100 ms，但更好的设置可能是55 ms，即事件时间片。

另外关键是如果stdin上存在事件，ReadConsoleInput是非阻塞的，而不仅仅是要读取的键。当识别的事件不是密钥时使用它，有效地清除事件，允许应用程序继续。可以使用它来从缓冲区中读取字节而不使用ReadFile：

PeekConsoleInput hStdIn, baBuffer(0), 1, lEvents
If lEvents > 0 Then
    Call ReadConsoleInput(hStdIn, baBuffer(0), 1, lEvents)
    If baBuffer(0) = KEY_EVENT And baBuffer(4) <> 0 Then
        ' Chr(baBuffer(14)) now produces the character typed...

除了在构建过程中最简单的调试之外，这还没有经过测试来读取真正的人工输入，但它确实有效，并且应该允许大多数基于VB6表单的应用程序有效地使用控制台。谢谢wqw！

stdin的非阻塞读取？

3 个答案: