Вопрос по vb6, console-application, stdio – Неблокирующее чтение стандартного ввода?

2

Мне нужно, чтобы мое приложение на основе форм периодически проверяло ввод на ввод, но все равно выполняло другую обработку. Scripting.TextStream.Read () и API ReadFile () блокируют, есть ли неблокирующий метод чтения stdin в VB6?

С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

Я пробовал API-интерфейс ReadConsole (), и все они блокируются.

Попробуйте использоватьGetStdHandle(STD_INPUT_HANDLE) как труба. wqw
Рассматривал использование WaitForSingleObject (), но он срабатывает при фокусировке консоли, а ReadFile () и ReadConsole () отбрасывают эти события, поэтому есть ложные срабатывания. MarkFisher
Если вы собираетесь сделать это опрос, используйтеPeekNamedPipe проверить, доступен ли какой-либо вход. wqw
@wqw - я не могу заставить это работать, PeekNamedPipe () никогда не сообщает о наличии байтов; стандартный ввод не является именованным каналом. Вы получили это на работу? Не могли бы вы опубликовать пример кода? MarkFisher
@wqw - Как? Stdin не является именованным каналом. Есть ли способ преобразовать или перенаправить его, о котором я не знаю? MarkFisher

Ваш Ответ

3   ответа
1

что мне пока не удалось заставить это работать, однако кто-то еще мог бы попробовать. Идея заключалась в том, чтобы использовать асинхронный ввод-вывод с консольным вводом std (я предполагаю, что идея вашего приложения - позволить людям писать прямо в окно консоли и читать ввод по мере его поступления).

Я отделил все вещи 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) для связи с основным графическим интерфейсом.

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

К сожалению, хотя CreateFile () с использованием FILE_FLAG_OVERLAPPED должен создать дескриптор файла, который можно использовать с асинхронным вводом-выводом, и дескриптор кажется действительным, ReadFileEx () возвращает 0, а GetLastError равен 6, что:

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

Интересно, что консоль заморожена, хотя все это происходит.

У кого-то еще есть идеи? Документы, похоже, предполагают, что если вы используете CreateFile () с именем устройства консоли, параметр игнорируется.

Так что полностью попробовал это, это имело смысл и для меня тоже. Ни перекрытие, ни обратный вызов не решают проблему, хотя ReadFileEx ведет себя так же, как и ReadFile, когда нет символа @ STDIN. Рад, что кто-то думал так же, как я, и очень хороший код, кстати. +1 MarkFisher
0

но приведенные там прототипы для Peek / ReadConsoleInput допускают одно, которое делает:

Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel,32" (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Я так далеко не проверял). Они все еще работают, однако, по крайней мере, Пик ... делает.

Ключевым моментом является то, что на каждом проходе читается только один байт, поскольку чтение того, что находится в baBuffer, проблематично после первой записи (структура INPUT_RECORD), но неблокируемый один байт лучше, чем вообще никакого. Для меня Timer1 установлен на 100 мс, но лучшая настройка может быть 55 мс, интервал времени событий.

Также ключ заключается в том, что ReadConsoleInput является неблокирующим, если в stdin присутствует событие, а не просто ключ для чтения. Использование его, когда распознанное событие не является ключом, эффективно очищает событие, позволяя приложению продолжить работу. Это можно использовать для чтения байтов из буфера без использования 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!

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
Этот код не работает для приложения на основе форм, хотя прототипы API для Peek / ReadConsoleInput дали мне возможность создать подпрограмму, которая работает. Разместим код в отдельном ответе, но это работает, вы получаете галочку. Спасибо! MarkFisher

Похожие вопросы