CreateConsole




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










( createconsole.html )- by Paolo Puglisi - Modifica del 17/12/2023