Option Explicit
 
'-----------------------------------------
'Autor: Karcrack                          |
'Creditos: MSDN                           |
'Fecha: 10/10/08                          |
'Web: http://foro.fire-software.net       |
'Utilidad: Ejemplo de uso de las APIs para|
'enviar y recibir informacion con         |
'aplicaciones de Command Line.            |
'=========================================|
'Puedes distribuir libremente este codigo |
'Siempre que pongas el autor.             |
'------------------------------------------
 
Enum Colors
    Negro = &H0
    Azul = &H1
    Verde = &H2
    AguaMarina = &H3
    Red = &H4
    Purpura = &H5
    Amarillo = &H6
    Blanco = &H7
    Gris = &H8
    AzulClaro = &H9
    VerdeClaro = &HA&
    AguamarinaClaro = &HB&
    RojoClaro = &HC&
    PurpuraClaro = &HD&
    AmarilloClaro = &HE&
    BlancoBrillante = &HF&
End Enum
 
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 Const STD_OUTPUT_HANDLE = -11&
Private Const STD_INPUT_HANDLE = -10&
Private Const STD_ERROR_HANDLE = -12&
Private Const INVALID_HANDLE_VALUE = -1&
 
Private mvarTitle   As String
Private mvarFColor  As Double
Private mvarBColor  As Double
Private hCMDIn      As Double
Private hCMDOut     As Double
 
Private Declare Function AllocConsole Lib "kernel32.dll" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, ByVal lpBuffer As String, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) 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
 
Public Function GetData(Optional ByVal dCharacters As Double, Optional ByVal bLine As Boolean) As String
    Dim lPos            As Long
 
    GetData = String$(IIf(dCharacters = 0, 500, dCharacters), 0)
 
    Call ReadConsole(hCMDIn, GetData, Len(GetData), lPos, vbNull)
    GetData = Left$(GetData, lPos)
 
    If bLine = True Then
        GetData = Mid$(GetData, InStrRev(GetData, vbCrLf))
    End If
End Function
 
Public Function SendData(ByVal sData As String, Optional ByVal dNewFColor As Colors, Optional ByVal dNewBColor As Colors) As Boolean
    Dim dLenWritten     As Long
    Dim Color1          As Long
    Dim Color2          As Long
 
    If dNewFColor Then
        Color1 = dNewFColor
    Else
        Color1 = mvarFColor
    End If
 
    If dNewBColor Then
        Color2 = dNewBColor
    Else
        Color2 = mvarBColor
    End If
 
    Call SetConsoleTextAttribute(hCMDOut, Color1 Or Color2)
    Call WriteConsole(hCMDOut, ByVal sData, Len(sData), dLenWritten, ByVal 0&)
    If dLenWritten = Len(sData) Then
        SendData = True
    End If
    Call SetConsoleTextAttribute(hCMDOut, mvarFColor Or mvarBColor)
End Function
 
Public Property Let ForeColor(ByVal vData As Colors)
    mvarFColor = vData
    Call SetConsoleTextAttribute(hCMDOut, mvarFColor Or mvarBColor)
End Property
 
Public Property Get ForeColor() As Colors
    ForeColor = mvarFColor
End Property
 
Public Property Let BackColor(ByVal vData As Colors)
    mvarBColor = vData
    Call SetConsoleTextAttribute(hCMDOut, mvarFColor Or mvarBColor)
End Property
 
Public Property Get BackColor() As Colors
    BackColor = mvarBColor
End Property
 
Public Property Let Title(ByVal vData As String)
    mvarTitle = vData
    Call SetConsoleTitle(mvarTitle)
End Property
 
Public Property Get Title() As String
    Title = mvarTitle
End Property
 
Private Sub Class_Initialize()
    If App.LogMode = 0 Then AllocConsole
    hCMDOut = GetStdHandle(STD_OUTPUT_HANDLE)
    hCMDIn = GetStdHandle(STD_INPUT_HANDLE)
    Call SetConsoleTitle(mvarTitle)
    Call SetConsoleTextAttribute(hCMDOut, mvarFColor Or mvarBColor)
End Sub
 
Private Sub Class_Terminate()
    CloseHandle hCMDOut
    CloseHandle hCMDIn
    If App.LogMode = 0 Then FreeConsole
End Sub