Option Explicit

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 ReadConsole Lib "kernel32" Alias _
        "ReadConsoleA" (ByVal hConsoleInput As Long, ByVal _
        lpBuffer As String, ByVal nNumberOfCharsToRead As Long, _
        ByRef lpNumberOfCharsRead As Long, lpReserved As Long) As Long

Private Declare Function SetConsoleMode Lib "kernel32" (ByVal _
        hConsoleOutput As Long, dwMode As Long) As Long

Private Declare Function SetConsoleTextAttribute Lib "kernel32" _
        (ByVal hConsoleOutput As Long, ByVal wAttributes As Long) _
        As Long

Private Declare Function SetConsoleTitle Lib "kernel32" Alias _
        "SetConsoleTitleA" (ByVal lpConsoleTitle As String) _
        As Long

Private Declare Function WriteConsole Lib "kernel32" Alias _
        "WriteConsoleA" (ByVal hConsoleOutput As Long, ByVal _
        lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, _
        ByRef lpNumberOfCharsWritten As Long, lpReserved As Long) As Long

Private Const STD_INPUT_HANDLE As Long = -10&
Private Const STD_OUTPUT_HANDLE As Long = -11&
Private Const STD_ERROR_HANDLE As Long = -12&

Private Const FOREGROUND_BLUE As Long = &H1&
Private Const FOREGROUND_GREEN As Long = &H2&
Private Const FOREGROUND_RED As Long = &H4&
Private Const FOREGROUND_INTENSITY As Long = &H8&
Private Const BACKGROUND_BLUE As Long = &H10&
Private Const BACKGROUND_GREEN As Long = &H20&
Private Const BACKGROUND_RED As Long = &H40&
Private Const BACKGROUND_INTENSITY As Long = &H80&

Private Const ENABLE_LINE_INPUT As Long = &H2&
Private Const ENABLE_ECHO_INPUT As Long = &H4&
Private Const ENABLE_MOUSE_INPUT As Long = &H10&
Private Const ENABLE_PROCESSED_INPUT As Long = &H1&
Private Const ENABLE_WINDOW_INPUT As Long = &H8&

Private Const ENABLE_PROCESSED_OUTPUT As Long = &H1&
Private Const ENABLE_WRAP_AT_EOL_OUTPUT As Long = &H2&

Private hConsoleIn As Long
Private hConsoleOut As Long
Private hConsoleErr As Long

Private Sub ConsolePrint(szOut As String)
    Dim BytesWritten As Long
    
    Call WriteConsole(hConsoleOut, szOut, Len(szOut), BytesWritten, 0&)
End Sub

Private Function ConsoleRead() As String
    Dim sUserInput As String * 256
    Dim BytesRead As Long
    
    Call ReadConsole(hConsoleIn, sUserInput, Len(sUserInput), _
                     BytesRead, 0&)
    
    ' - 2, um vbCrLf abzuschneiden
    ConsoleRead = Left$(sUserInput, BytesRead - 2)
End Function

Private Function CreateConsole() As String
    Dim szUserInput As String
    Dim s As String
    Call AllocConsole
    Call SetConsoleTitle("VB Konsole")
    
    hConsoleIn = GetStdHandle(STD_INPUT_HANDLE)
    hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
    hConsoleErr = GetStdHandle(STD_ERROR_HANDLE)
        
    Call SetConsoleTextAttribute(hConsoleOut, FOREGROUND_GREEN Or _
            FOREGROUND_BLUE Or FOREGROUND_BLUE Or _
            FOREGROUND_INTENSITY Or BACKGROUND_BLUE)
            
    Call ConsolePrint("VB Konsole" & vbCrLf)
    Call SetConsoleTextAttribute(hConsoleOut, FOREGROUND_RED Or _
            FOREGROUND_GREEN Or FOREGROUND_BLUE)
    
GoBack:
    Call ConsolePrint("VB Konsole> ")
    
    DoEvents
    szUserInput = ConsoleRead()
    If LCase(szUserInput) = "exit" Or LCase(szUserInput) = "quit" Then
        GoTo GoExit
    ElseIf szU = "hello" Then
        Call ConsolePrint("Hallo!" & vbCrLf)
    Else
        Call ConsolePrint("Sie haben " & szUserInput & " eingegeben" & vbCrLf)
    End If
    
    GoTo GoBack
    
GoExit:
    Call ConsolePrint("Bis bald" & vbCrLf & "Bitte druecken Sie die Enter-Taste um das Fenster zu schliessen")
    
    Call ConsoleRead 'Wenn Sie diesen Befehl loeschen, wird das Fenster sofort geschlossen,
                     'und Sie muessen nicht die Enter-Taste druecken.
    Call FreeConsole 'Hiermit schliessen Sie die Konsole
End Function

Sub Main()
    CreateConsole
End Sub