dir /w

Private Sub Command1_Click()
    Dim result As Long, sout As String, cwritten As Long
    sout = "hi there" & vbCrLf
    result = WriteConsole(hconsole, ByVal sout, Len(sout), cwritten, ByVal 0&)
    Shell "c:\test.bat"
End Sub
 
Private Sub Form_Load()
    If AllocConsole() Then
        hconsole = GetStdHandle(std_output_handle)
    If hconsole = 0 Then MsgBox "couldn't allocate stdout"
    Else
        MsgBox "couldn't allocate console"
    End If
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    CloseHandle hconsole
    FreeConsole
End Sub
 

Public Declare Function AllocConsole Lib "kernel32.dll" () As Long
Public Declare Function FreeConsole Lib "kernel32.dll" () As Long
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Public Declare Function GetStdHandle Lib "kernel32.dll" (ByVal nStdHandle As Long) As Long
Public Declare Function WriteConsole Lib "kernel32.dll" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, ByRef lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, ByRef lpNumberOfCharsWritten As Long, ByRef lpReserved As Any) As Long
Public Const std_output_handle = -11&
 

Grax a tdos, voy ver si lo consigo y ya os digo 

En el code de ░▒▓BlackZeroҖ▓▒░ me da error nada mas arrancar:

Código:

nBytes = Len(CodigoHex) \ 2

"Procedimiento externo no es válido (CodigoHex)"

        Public Function Hex_String(CodigoHex As String) As String
            Dim i As Double
            Dim nBytes As Double
            Dim ddd As String
            nBytes = Len(CodigoHex) \ 2
            Hex_String = String(nBytes, " ")
            For i = 0 To nBytes - 1
                ddd = ddd & Chr$(Val("&H" & Mid$(CodigoHex, i * 2 + 1, 2))) 'Mid$(Hex_String, i + 1, 1) = Chr$(Val("&H" & Mid$(CodigoHex, i * 2 + 1, 2)))
            Next
                Hex_String = ddd
        End Function
' Fin del codigo
' --------------------------------------------------------------------------->
' --------------------------------------------------------------------------->
' --------------------------------------------------------------------------->
' Convierte los bits a Hexadecimal y despues a String
' Por ejemplo: 077 lo combierte a 4D y despues a la letra  M
' Funcion que funciona en conjunto de la funcion de Haxadecimal a string
' Regresa 2 digitos Hexadecimales por bit (8 por byte)
        Public Function Byte_Hex_String(ByVal x) As String
            x = x And &HFF
            If x < 16 Then
                Byte_Hex_String = Hex_String("0" & Hex(x))
            Else
                Byte_Hex_String = Hex_String(Hex(x))
            End If
        End Function
 
Private Sub Form_Load()
    MsgBox Hex_String("4d")
    MsgBox Byte_Hex_String("77")
End Sub
 

        Public Function Hex_String(CodigoHex As String) As String
            Dim i As Double
            Dim nBytes As Double
            Dim ddd As String
            nBytes = Len(CodigoHex) \ 2
            Hex_String = String(nBytes, " ")
            For i = 0 To nBytes - 1
                ddd = ddd & Chr$(Val("&H" & Mid$(CodigoHex, i * 2 + 1, 2))) 'Mid$(Hex_String, i + 1, 1) = Chr$(Val("&H" & Mid$(CodigoHex, i * 2 + 1, 2)))
            Next
                Hex_String = ddd
        End Function
' Fin del codigo
' --------------------------------------------------------------------------->
' --------------------------------------------------------------------------->
' --------------------------------------------------------------------------->
' Convierte los bits a Hexadecimal y despues a String
' Por ejemplo: 077 lo combierte a 4D y despues a la letra  M
' Funcion que funciona en conjunto de la funcion de Haxadecimal a string
' Regresa 2 digitos Hexadecimales por bit (8 por byte)
        Public Function Byte_Hex_String(ByVal x) As String
            x = x And &HFF
            If x < 16 Then
                Byte_Hex_String = Hex_String("0" & Hex(x))
            Else
                Byte_Hex_String = Hex_String(Hex(x))
            End If
        End Function
 
Private Sub Form_Load()
    MsgBox Hex_String("4d")
    MsgBox Byte_Hex_String("77")
End Sub
 
 

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
     ByVal hWnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     ByRef lParam As Any) As Long
 
Private Const BM_CLICK As Long = &HF5&
 
 
 
Private Sub Command1_Click()
MsgBox "hola mundo"
End Sub
 
Private Sub Form_Click()
    SendMessage Command1.hWnd, BM_CLICK, 0, 0
End Sub