Public Function WriteCon(s As String) As Long
Dim info As STARTUPINFO
Dim TMP As Long
Dim result As Long
Dim sOut As String
    AllocConsole
    GetStartupInfo info
    sOut = "cool" & Chr( 0 )
    TMP = GetStdHandle(STD_OUTPUT_HANDLE)
    WriteFile TMP, ByVal sOut,  4 , TMP,  0 
    MsgBox  1 
    FreeConsole
End Function

InitializeConsole
ConPrint "COOL"

'///////////////////////////////////////////////////////////////////////////
'// Ìîäóëü äëÿ ðàáîòû ñ êîíñîëüþ                                          //
'// Copyright (c) 2004 Äìèòðèé Êîçûðåâ, me@mastershome.net.ru             //
'///////////////////////////////////////////////////////////////////////////
Option Explicit

Public Enum enmConsoleHandle
    chInput
    chOutput
    chError
End Enum

Public Enum enmBreakMode
    bmCtrlC =  0 
    bmCtrlBReak =  1 
    bmClose =  2 
    bmLogOff =  5 
    bmShutdown =  6 
    bmNoBrake = - 1 
End Enum

Public Enum enmColor
    clBlue =  1 
    clGreen =  2 
    clRed =  4 
    clIntensity =  8 
End Enum

Public Enum enmEventType
    etKeyEvent =  1 
    etMouseEvent =  2 
    etWindowBufferSizeEvent =  4 
    etMenuEvent =  8 
    etFocusEvent =  16 
    etNone =  0 
End Enum

Public Enum enmControlKeyState
    csRightAltPressed = &H1
    csLeftAltPressed = &H2
    csRightCtrlPressed = &H4
    csleftCtrlPressed = &H8
    csShiftPressed = &H10
    csNumlockOn = &H20
    csScrollLockOn = &H40
    csCapsLockOn = &H80
    csEnhancedKey = &H100
End Enum

Public Enum enmMouseEventFlags
    CLICK_OR_RELEASE =  0 
    MOUSE_MOVED =  1 
    DOUBLE_CLICK =  2 
    MOUSE_WHEELED =  4 
End Enum

Public Enum enmMouseButton
    FROM_LEFT_1ST_BUTTON_PRESSED =  1 
    RIGHTMOST_BUTTON_PRESSED =  2 
    FROM_LEFT_2ND_BUTTON_PRESSED =  4 
    FROM_LEFT_3RD_BUTTON_PRESSED =  8 
    FROM_LEFT_4TH_BUTTON_PRESSED =  16 
End Enum

Private bCtrlHandler() As Byte
Private mBrakeMode As Long

Private hStdIn      As Long
Private hStdOut     As Long
Private hStdErr     As Long

Private mReadBuffer As String

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 Const STD_INPUT_HANDLE = - 10 &
Private Const STD_OUTPUT_HANDLE = - 11 &
Private Const STD_ERROR_HANDLE = - 12 &

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

Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" _
    (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" _
    (ByVal lpszSrc As String, ByVal lpszDst As String) 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 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 GetConsoleCursorInfo Lib "kernel32" _
    (ByVal hConsoleOutput As Long, _
    lpConsoleCursorInfo As CONSOLE_CURSOR_INFO) As Long

Private Declare Function SetConsoleCursorInfo Lib "kernel32" _
    (ByVal hConsoleOutput As Long, _
    lpConsoleCursorInfo As CONSOLE_CURSOR_INFO) As Long

Private Type CONSOLE_CURSOR_INFO
    dwSize As Long
    bVisible As Long
End Type

Private Declare Function GetNumberOfConsoleInputEvents Lib "kernel32" _
    (ByVal hConsoleInput As Long, _
    lpNumberOfEvents As Long) As Long

Private Const ERROR_INVALID_HANDLE =  6 &

Private Declare Function GetConsoleScreenBufferInfo Lib "kernel32" _
    (ByVal hConsoleOutput As Long, _
    lpConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO) As Long

Private Declare Function SetConsoleCursorPosition Lib "kernel32" _
    (ByVal hConsoleOutput As Long, _
    ByVal Coord As Long) As Long

Private Type Coord
    X As Integer
    Y As Integer
End Type

Private Type SMALL_RECT
    Left As Integer
    Top As Integer
    Right As Integer
    Bottom As Integer
End Type

Private Type CONSOLE_SCREEN_BUFFER_INFO
    dwSize As Coord
    dwCursorPosition As Coord
    wAttributes As Integer
    srWindow As SMALL_RECT
    dwMaximumWindowSize As Coord
End Type

Private Declare Function SetConsoleScreenBufferSize Lib "kernel32" _
    (ByVal hConsoleOutput As Long, _
    ByVal dwSize As Long) As Long

Private Declare Function SetConsoleCtrlHandler Lib "kernel32" _
    (ByVal HandlerRoutine As Long, _
    ByVal Add As Long) As Long

Private Declare Function FillConsoleOutputAttribute Lib "kernel32" _
    (ByVal hConsoleOutput As Long, _
    ByVal wAttribute As Long, _
    ByVal nLength As Long, _
    ByVal dwWriteCoord As Long, _
    lpNumberOfAttrsWritten As Long) As Long

Private Declare Function FillConsoleOutputCharacter Lib "kernel32" _
    Alias "FillConsoleOutputCharacterA" _
    (ByVal hConsoleOutput As Long, _
    ByVal cCharacter As Byte, _
    ByVal nLength As Long, _
    ByVal dwWriteCoord As Long, _
    lpNumberOfCharsWritten As Long) As Long

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

Private Declare Function GetConsoleMode Lib "kernel32" _
    (ByVal hConsoleHandle As Long, _
    lpMode As Long) As Long

Private Const ENABLE_LINE_INPUT = &H2
Private Const ENABLE_ECHO_INPUT = &H4
Private Const ENABLE_MOUSE_INPUT = &H10
Private Const ENABLE_PROCESSED_INPUT = &H1
Private Const ENABLE_WINDOW_INPUT = &H8
Private Const ENABLE_PROCESSED_OUTPUT = &H1
Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2

Private Declare Function ReadConsoleOutputCharacter Lib "kernel32" _
    Alias "ReadConsoleOutputCharacterA" _
    (ByVal hConsoleOutput As Long, _
    ByVal lpCharacter As String, _
    ByVal nLength As Long, _
    ByVal dwReadCoord As Long, _
    lpNumberOfCharsRead As Long) As Long

Private Declare Function ReadConsoleOutputAttribute Lib "kernel32" _
    (ByVal hConsoleOutput As Long, _
    lpAttribute As Long, _
    ByVal nLength As Long, _
    ByVal dwReadCoord As Long, _
    lpNumberOfAttrsRead As Long) As Long

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

Private Declare Function ReadConsoleInput Lib "kernel32" Alias "ReadConsoleInputA" _
    (ByVal hConsoleInput As Long, _
    InputRecord As INPUT_RECORD, _
    ByVal nRecords As Long, _
    ByRef nEventsRead As Long) As Long

Private Declare Function PeekConsoleInput Lib "kernel32" Alias "PeekConsoleInputA" _
    (ByVal hConsoleInput As Long, _
    InputRecord As INPUT_RECORD, _
    ByVal nRecords As Long, _
    ByRef nEventsRead As Long) As Long

Private Type INPUT_RECORD
    EventType           As Integer
    Reserved            As Integer
    EventData( 0  To  15 )  As Byte
End Type

Public Type KEY_EVENT_RECORD
    bKeyDown            As Long
    wRepeatCount        As Integer
    wVirtualKeyCode     As Integer
    wVirtualScanCode    As Integer
    Char                As Byte
    Reserved            As Byte
    dwControlKeyState   As Long
End Type

Public Type MOUSE_EVENT_RECORD
    dwMousePosition As Coord
    dwButtonState As Long
    dwControlKeyState As Long
    dwEventFlags As Long
End Type

Public Type WINDOW_BUFFER_SIZE_RECORD
    dwSize As Coord
End Type

Private Declare Function FlushConsoleInputBuffer Lib "kernel32" _
    (ByVal hConsoleInput As Long) As Long

Private Declare Function MsgWaitForMultipleObjects Lib "user32" _
    (ByVal nCount As Long, _
    pHandles As Long, _
    ByVal fWaitAll As Long, _
    ByVal dwMilliseconds As Long, _
    ByVal dwWakeMask As Long) As Long

Private Const QS_ALLINPUT = &HFF&
Private Const WAIT_OBJECT_0 =  0 
Private Const INFINITE = &HFFFFFFFF

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

Private Declare Function PeekNamedPipe Lib "kernel32" _
    (ByVal hNamedPipe As Long, _
    lpBuffer As Any, _
    ByVal nBufferSize As Long, _
    lpBytesRead As Long, _
    lpTotalBytesAvail As Long, _
    lpBytesLeftThisMessage As Long) As Long

Public Property Get BreakMode() As enmBreakMode
BreakMode = mBrakeMode
End Property

Public Property Get Caption() As String
Dim sCaption As String
sCaption = String$( 256 ,  0 )
sCaption = Left$(sCaption, GetConsoleTitle(sCaption, Len(sCaption)))
Caption = sCaption
End Property

Public Property Let Caption(ByVal NewCaption As String)
SetConsoleTitle NewCaption
End Property

Public Sub Clear()
FillWithChar  0 ,  0 , Width * Height,  0 , False
MoveCursor  0 ,  0 
End Sub

Public Sub ConPrint(Optional ByVal Text As String, _
    Optional ByVal EndLine As Boolean = True, _
    Optional ByVal AutoTranslate As Boolean = True, _
    Optional ByVal ToError As Boolean = False)
Dim sOut As String
sOut = String$(Len(Text),  0 )

If AutoTranslate Then CharToOem Text, sOut

If EndLine Then sOut = sOut & vbCrLf

Dim w As Long, h As Long
h = IIf(ToError, hStdErr, hStdOut)

WriteFile h, ByVal sOut, Len(sOut), w, ByVal  0 &
End Sub

Public Function ConRead( _
    Optional ByVal AutoTranslate As Boolean = True) As String
Dim sIn As String, sRet As String, r As Long, lAvail As Long

sIn = String$( 256 ,  0 )

Do While InStr(mReadBuffer, vbCrLf) =  0 
    If PeekNamedPipe(hStdIn, ByVal  0 &,  0 , ByVal  0 &, lAvail, ByVal  0 &) Then
        If lAvail =  0  Then Exit Do
    End If
    If ReadFile(hStdIn, ByVal sIn, Len(sIn), r, ByVal  0 &) Then
        mReadBuffer = mReadBuffer & Left$(sIn, r)
    Else
        Exit Do
    End If
Loop

Dim iLineEnd As Long
iLineEnd = InStr(mReadBuffer, vbCrLf)
If iLineEnd Then
    sRet = Left$(mReadBuffer, iLineEnd -  1 )
    mReadBuffer = Mid$(mReadBuffer, iLineEnd +  2 )
Else
    sRet = mReadBuffer
    mReadBuffer = vbNullString
End If

If AutoTranslate Then OemToChar sRet, sRet

ConRead = sRet
End Function

Public Property Get CursorVisible() As Boolean
Dim ci As CONSOLE_CURSOR_INFO
GetConsoleCursorInfo hStdOut, ci
CursorVisible = ci.bVisible
End Property

Public Property Let CursorVisible(ByVal NewVisibility As Boolean)
Dim ci As CONSOLE_CURSOR_INFO
GetConsoleCursorInfo hStdOut, ci

ci.bVisible = Abs(NewVisibility)

SetConsoleCursorInfo hStdOut, ci
End Property

Public Property Get CursorHeight() As Double
Dim ci As CONSOLE_CURSOR_INFO
GetConsoleCursorInfo hStdOut, ci
CursorHeight = CDbl(ci.dwSize) /  100 
End Property

Public Property Let CursorHeight(ByVal NewHeight As Double)
Dim ci As CONSOLE_CURSOR_INFO
GetConsoleCursorInfo hStdOut, ci

If NewHeight <  0 . 01  Then NewHeight =  0 . 01 
If NewHeight >  1  Then NewHeight =  1 

ci.dwSize = NewHeight *  100 

SetConsoleCursorInfo hStdOut, ci
End Property

Public Property Get CursorX() As Integer
Dim si As CONSOLE_SCREEN_BUFFER_INFO
GetConsoleScreenBufferInfo hStdOut, si
CursorX = si.dwCursorPosition.X
End Property

Public Property Get CursorY() As Integer
Dim si As CONSOLE_SCREEN_BUFFER_INFO
GetConsoleScreenBufferInfo hStdOut, si
CursorY = si.dwCursorPosition.Y
End Property

Public Property Let CursorX(ByVal NewX As Integer)
Dim si As CONSOLE_SCREEN_BUFFER_INFO
GetConsoleScreenBufferInfo hStdOut, si
SetConsoleCursorPosition hStdOut, GetCoord(NewX, si.dwCursorPosition.Y)
End Property

Public Property Let CursorY(ByVal NewY As Integer)
Dim si As CONSOLE_SCREEN_BUFFER_INFO
GetConsoleScreenBufferInfo hStdOut, si
SetConsoleCursorPosition hStdOut, GetCoord(si.dwCursorPosition.X, NewY)
End Property

Public Sub DiscardEvent()
Dim r As INPUT_RECORD
Dim lRead As Long
If PeekConsoleInput(hStdIn, r,  1 , lRead) And lRead >  0  Then
    ReadConsoleInput hStdIn, r,  1 , lRead
End If
End Sub

Public Property Get EndOfInput() As Boolean
Dim sIn As String, r As Long, lAvail As Long
sIn = String$( 256 ,  0 )

If PeekNamedPipe(hStdIn, ByVal  0 &,  0 , ByVal  0 &, lAvail, ByVal  0 &) Then
    EndOfInput = (lAvail =  0 )
ElseIf ReadFile(hStdIn, ByVal sIn, Len(sIn), r, ByVal  0 &) Then
    EndOfInput = (r =  0 )
    mReadBuffer = mReadBuffer & Left$(sIn, r)
Else
    EndOfInput = True
End If
End Property

Public Sub Fill(ByVal X As Integer, ByVal Y As Integer, _
    ByVal nCells As Long, ByVal ForeColor As enmColor, _
    ByVal BackColor As enmColor)
Dim lWritten As Long
FillConsoleOutputAttribute hStdOut, MakeColor(ForeColor, BackColor), _
    nCells, GetCoord(X, Y), lWritten
End Sub

Public Sub FillWithChar(ByVal X As Integer, ByVal Y As Integer, _
    ByVal nCells As Long, ByVal Character As Byte, _
    Optional ByVal AutoTranslate As Boolean = True)
Dim lWritten As Long
FillConsoleOutputCharacter hStdOut, Character, nCells, _
    GetCoord(X, Y), lWritten
End Sub

Public Sub FlushInputBuffer()
FlushConsoleInputBuffer hStdIn
End Sub

Public Property Get ForeColor() As enmColor
Dim si As CONSOLE_SCREEN_BUFFER_INFO
GetConsoleScreenBufferInfo hStdOut, si
ForeColor = (si.wAttributes And &HF&)
End Property

Public Property Get BackColor() As enmColor
Dim si As CONSOLE_SCREEN_BUFFER_INFO
GetConsoleScreenBufferInfo hStdOut, si
BackColor = ((si.wAttributes And &HF0&) \ &H10&)
End Property

Public Property Let ForeColor(ByVal NewColor As enmColor)
SetConsoleTextAttribute hStdOut, (NewColor And &HF) Or BackColor * &H10&
End Property

Public Property Let BackColor(ByVal NewColor As enmColor)
SetConsoleTextAttribute hStdOut, (NewColor And &HF) * &H10& Or ForeColor
End Property

Private Function GetCoord(ByVal X As Integer, ByVal Y As Integer) As Long
Dim lRes As Long
Dim c As Coord
c.X = X
c.Y = Y
CopyMemory lRes, c,  4 
GetCoord = lRes
End Function

Public Property Get HasBreak() As Boolean
HasBreak = (mBrakeMode <> bmNoBrake)
End Property

Public Function GetInputEventType() As enmEventType
Dim r As INPUT_RECORD
Dim lRead As Long
GetInputEventType = etNone
If PeekConsoleInput(hStdIn, r,  1 , lRead) Then
    If lRead >  0  Then
        GetInputEventType = r.EventType
    End If
End If
End Function

Public Function WaitForEvent() As enmEventType
Dim r As INPUT_RECORD
Dim lRead As Long

WaitForEvent = etNone

Do While MsgWaitForMultipleObjects( 1 , hStdIn,  0 , INFINITE, _
            QS_ALLINPUT) <> WAIT_OBJECT_0
    DoEvents
    If HasBreak Then Exit Do
Loop

If PeekConsoleInput(hStdIn, r,  1 , lRead) And lRead >  0  Then
    WaitForEvent = r.EventType
End If
End Function

Private Function MakeColor(ByVal ForeColor As enmColor, _
    ByVal BackColor As enmColor) As Integer
MakeColor = (ForeColor And &HF) + (BackColor And &HF) * &H10
End Function

Public Sub MoveCursor(ByVal X As Integer, ByVal Y As Integer)
Dim NewPos As Coord
NewPos.X = X
NewPos.Y = Y
SetConsoleCursorPosition hStdOut, GetCoord(X, Y)
End Sub

Public Property Get IsConsole(ByVal Handle As enmConsoleHandle) As Boolean
Dim b As Boolean
Select Case Handle
    Case chInput
        Dim l As Long
        b = CBool(GetNumberOfConsoleInputEvents(hStdIn, l))
        IsConsole = b And (Err.LastDllError <> ERROR_INVALID_HANDLE)
    Case chOutput, chError
        Dim h As Long, ci As CONSOLE_CURSOR_INFO
        If Handle = chOutput Then h = hStdOut Else h = hStdErr
        b = CBool(GetConsoleCursorInfo(h, ci))
        IsConsole = b And (Err.LastDllError <> ERROR_INVALID_HANDLE)
End Select
End Property

Public Function ReadDataFromOutput(ByVal X As Integer, ByVal Y As Integer, _
    ByVal nCells, Optional ByVal AutoTranslate As Boolean = True) As String
Dim s As String, lRead As Long
s = String$(nCells,  0 )
ReadConsoleOutputCharacter hStdOut, s, nCells, GetCoord(X, Y), lRead
s = Left$(s, lRead)

If AutoTranslate Then OemToChar s, s

ReadDataFromOutput = s
End Function

Public Function ReadForeColorFromOutput(ByVal X As Integer, _
    ByVal Y As Integer) As enmColor
Dim lColor As Long, lRead As Long
ReadConsoleOutputAttribute hStdOut, lColor,  1 , GetCoord(X, Y), lRead
ReadForeColorFromOutput = (lColor And &HF&)
End Function

Public Function ReadBackColorFromOutput(ByVal X As Integer, _
    ByVal Y As Integer) As enmColor
Dim lColor As Long, lRead As Long
ReadConsoleOutputAttribute hStdOut, lColor,  1 , GetCoord(X, Y), lRead
ReadBackColorFromOutput = ((lColor And &HF0&) \ &H10&)
End Function

Public Function ReadKey() As KEY_EVENT_RECORD
Dim r As INPUT_RECORD
Dim lRead As Long
Do While ReadConsoleInput(hStdIn, r,  1 , lRead)
    If r.EventType = etKeyEvent Then
        CopyMemory ReadKey, r.EventData( 0 ), Len(ReadKey)
        Exit Function
    End If
Loop
End Function

Public Function ReadMouse() As MOUSE_EVENT_RECORD
Dim r As INPUT_RECORD
Dim lRead As Long
Do While ReadConsoleInput(hStdIn, r,  1 , lRead)
    If r.EventType = etMouseEvent Then
        CopyMemory ReadMouse, r.EventData( 0 ), Len(ReadMouse)
        Exit Function
    End If
Loop
End Function

Public Function ReadWindowResize() As WINDOW_BUFFER_SIZE_RECORD
Dim r As INPUT_RECORD
Dim lRead As Long
Do While ReadConsoleInput(hStdIn, r,  1 , lRead)
    If r.EventType = etWindowBufferSizeEvent Then
        CopyMemory ReadWindowResize, r.EventData( 0 ), Len(ReadWindowResize)
        Exit Function
    End If
Loop
End Function

Public Property Get MouseInputEnabled() As Boolean
Dim lMode As Long
GetConsoleMode hStdIn, lMode
MouseInputEnabled = CBool(lMode And ENABLE_MOUSE_INPUT)
End Property

Public Property Let MouseInputEnabled(ByVal NewValue As Boolean)
Dim lMode As Long
GetConsoleMode hStdIn, lMode
lMode = lMode And (&HFFFFFFFF Xor ENABLE_MOUSE_INPUT)
If NewValue Then lMode = lMode Or ENABLE_MOUSE_INPUT
SetConsoleMode hStdIn, lMode
End Property

Public Property Let Width(ByVal NewWidth As Integer)
SetConsoleScreenBufferSize hStdOut, GetCoord(NewWidth, Height)
End Property

Public Property Let Height(ByVal NewHeight As Integer)
SetConsoleScreenBufferSize hStdOut, GetCoord(Width, NewHeight)
End Property

Public Property Get Width() As Integer
Dim si As CONSOLE_SCREEN_BUFFER_INFO
GetConsoleScreenBufferInfo hStdOut, si
Width = si.dwSize.X
End Property

Public Property Get Height() As Integer
Dim si As CONSOLE_SCREEN_BUFFER_INFO
GetConsoleScreenBufferInfo hStdOut, si
Height = si.dwSize.Y
End Property

Public Sub InitializeConsole()
AllocConsole

hStdIn = GetStdHandle(STD_INPUT_HANDLE)
hStdOut = GetStdHandle(STD_OUTPUT_HANDLE)
hStdErr = GetStdHandle(STD_ERROR_HANDLE)

Dim lMode As Long
GetConsoleMode hStdIn, lMode
lMode = lMode Or ENABLE_PROCESSED_INPUT Or ENABLE_WINDOW_INPUT Or _
    ENABLE_LINE_INPUT Or ENABLE_ECHO_INPUT
SetConsoleMode hStdIn, lMode
    
GetConsoleMode hStdOut, lMode
lMode = lMode Or ENABLE_WRAP_AT_EOL_OUTPUT Or ENABLE_PROCESSED_OUTPUT
SetConsoleMode hStdOut, lMode

MouseInputEnabled = True

mBrakeMode = bmNoBrake

ReDim bCtrlHandler( 0  To  13 )
bCtrlHandler( 0 ) = &H68                            ' push <variable address>
CopyMemory bCtrlHandler( 1 ), VarPtr(mBrakeMode),  4 
bCtrlHandler( 5 ) = &H5B                            ' pop ebx
bCtrlHandler( 6 ) = &H58                            ' pop eax
bCtrlHandler( 7 ) = &H8F                            ' pop dword ptr [ebx]
bCtrlHandler( 8 ) = &H3
bCtrlHandler( 9 ) = &H50                            ' push eax
bCtrlHandler( 10 ) = &H33                           ' xor eax, eax
bCtrlHandler( 11 ) = &HC0
bCtrlHandler( 12 ) = &H40                           ' inc eax
bCtrlHandler( 13 ) = &HC3                           ' ret

SetConsoleCtrlHandler VarPtr(bCtrlHandler( 0 )),  1 
End Sub

Public Sub TerminateConsole()
SetConsoleCtrlHandler VarPtr(bCtrlHandler( 0 )),  0 

FreeConsole
End Sub

Public Function WriteCon(s As String) As Long
Dim info As STARTUPINFO
Dim tmp As Long
Dim result As Long
Dim sOut As String
    AllocConsole
    GetStartupInfo info
    sOut = "cool" & Chr( 0 )
    tmp = GetStdHandle(STD_OUTPUT_HANDLE)
    WriteFile tmp, ByVal sOut,  4 , tmp,  0 
    MsgBox  1 
    FreeConsole
End Function