stdin的非阻塞读取？

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

随着Timer1设置为每100毫秒就发生一次，我已经试过：

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，也他们都阻止。

来源

2012-07-02 MarkFisher

看着使用WaitForSingleObject（），但它触发控制台焦点和ReadFile（）和ReadConsole（）放弃这些事件，所以有误报。 – MarkFisher

如果你打算这样做，那么轮询将使用'PeekNamedPipe'来检查是否有任何输入可用。 – wqw

@wqw - 怎么样？ Stdin不是一个命名管道。有没有办法转换或重定向，我不知道？ – MarkFisher

使用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-04 09:14:38 wqw

此代码不适用于基于表单的应用程序，尽管Peek/ReadConsoleInput的API原型使我能够构造一个例程。将在单独的答案中发布代码，但这是有效的，你会得到复选标记。谢谢！ – MarkFisher

恐怕我还没有设法让这个工作到目前为止，但其他人可能会有一个去。这些想法是使用控制台std输入的异步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） - 它使用一个定时器（定时器）和RichTextBox中（txtStdIn）：使用FILE_FLAG_OVERLAPPED应该创建一个文件句柄

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

不幸的是，虽然的CreateFile（）的可以与异步I/O使用，与手柄似乎有效，ReadFileEx（）返回0，并且GetLastError是6，其为：

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

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

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

来源

2012-07-04 00:13:11

所以完全尝试过这一点，这对我也有意义。重叠或回调都不能解决问题，但是，当没有字符存在时，ReadFileEx的行为与ReadFile相同@ STDIN。很高兴看到有人像我一样思考，并且非常漂亮的代码，顺便说一句。 +1 – MarkFisher

wqw的回答不会为一个基于表单的应用程序的工作，但对于皮克/ 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

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

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

关键还在于如果在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！

来源

2012-07-05 13:44:39 MarkFisher

stdin的非阻塞读取？

回答

相关问题