2

我需要让我的基于表单的应用程序定期检查标准输入以获取输入，但仍执行其他处理。Scripting.TextStream.Read() 和 ReadFile() API 是阻塞的，VB6 中是否有读取标准输入的非阻塞方法？

设置为每 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，它们都阻塞了。

4

3 回答 3

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) 和 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() 与控制台设备名称一起使用，则该参数将被忽略。

于 2012-07-04T00:13:11.173 回答
1

使用vbAdvance插件编译以下示例，并选中“构建为控制台应用程序”选项。

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
于 2012-07-04T09:14:38.727 回答
0

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 毫秒，但更好的设置可能是 55 毫秒，即事件时间片。

同样关键的是，如果标准输入上存在事件，则 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！

于 2012-07-05T13:44:39.480 回答