Crear aplicaciones de consola VB {AVANZADO} [Clase]

[Karcrack]

Bueno, como prometi aqui:

Crear aplicaciones de Consola con VB {INTERMEDIO}

Aqui traigo la Clase:

Código (vb) [Seleccionar] Expandir

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


Aqui la adjunto con algunos ejemplos:

Ejemplos clase cCommandLine

Saludos

[achernar_]

Porque una clase? En serio lo pregunto, si en un modulo simplón se pueden poner las funciones IniciarConsola (que retorne True si todo sale bien), EscribirEnConsola (que retorne el numero de caracteres escritos), LeerDesdeConsola (que guarda en un buffer el texto ingresado a la consola y retorne el numero de caracteres ingresados), TerminarConsola (retorno True o False y TituloDeConsola (puede ser solo una subrutina)

[Karcrack]

Simplemente porque es mas comodo al menos a mi parecer. Si cualquier persona tiene problemas con las clases que lo pasen a modulo, que como tu dices se puede hacer perfectamente 

Saludos