Private Declare Function SetConsoleMode Lib "kernel32" (ByVal hConsoleHandle As Long, ByVal dwMode As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) 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 GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long Private Const STD_INPUT_HANDLE = -10& Private Const STD_OUTPUT_HANDLE = -11& Private Const STD_ERROR_HANDLE = -12& Private Const ENABLE_PROCESSED_INPUT = &H1 Private Const ENABLE_LINE_INPUT = &H2 Private Const ENABLE_ECHO_INPUT = &H4 Public Function ConsoleStdOut(ByVal Output As String) As Long Dim hStdOut As Long Dim lngError As Long hStdOut = GetStdHandle(STD_OUTPUT_HANDLE) If WriteFile(hStdOut, ByVal Output, Len(Output), ConsoleStdOut, ByVal 0) = 0 Then lngError = Err.LastDllError If Not lngError = 0 Then Err.Raise lngError, "ConsoleStdOut()", ErrorMessage(lngError) End If End If End Function Public Function ConsoleStdError(ByVal Output As String) As Long Dim hStdOut As Long Dim lngError As Long hStdOut = GetStdHandle(STD_ERROR_HANDLE) If WriteFile(hStdOut, ByVal Output, Len(Output), ConsoleStdError, ByVal 0) = 0 Then lngError = Err.LastDllError If Not lngError = 0 Then Err.Raise lngError, "ConsoleStdError()", ErrorMessage(lngError) End If End If End Function Public Function ConsoleStdInLine(Optional ByVal MaxReturn As Long = 1028) As String Dim strBuffer As String Dim hStdIn As Long Dim lngError As Long strBuffer = String$(MaxReturn, vbNullChar) hStdIn = GetStdHandle(STD_INPUT_HANDLE) SetConsoleMode hStdIn, ENABLE_PROCESSED_INPUT Or ENABLE_LINE_INPUT Or ENABLE_ECHO_INPUT If ReadFile(hStdIn, ByVal strBuffer, MaxReturn, 0, ByVal 0) = 0 Then lngError = Err.LastDllError If Not lngError = 0 Then Err.Raise lngError, "ConsoleStdInLine()", ErrorMessage(lngError) End If Else strBuffer = Left$(strBuffer, InStr(1, strBuffer, vbNullChar) - 3) ConsoleStdInLine = strBuffer End If End Function Public Function ConsoleStdInChar() As String Dim strBuffer As String Dim hStdIn As Long Dim lngError As Long strBuffer = String$(1, vbNullChar) hStdIn = GetStdHandle(STD_INPUT_HANDLE) SetConsoleMode hStdIn, 0 If ReadFile(hStdIn, ByVal strBuffer, 1, 0, ByVal 0) = 0 Then lngError = Err.LastDllError If Not lngError = 0 Then Err.Raise lngError, "ConsoleStdInChar()", ErrorMessage(lngError) End If Else ConsoleStdInChar = strBuffer End If End Function Private Sub Main() Dim strResponse As String ConsoleStdOut "Hello, what is your name? " strResponse = ConsoleStdInLine ConsoleStdOut "Hello " & strResponse & "!" & vbCrLf End Sub |