虚拟主机教程

    Option Explicit
 
    '' API函数声明
    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, lpNumherOfCharsRead As Long, lpReserved As Any) As Long
    Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, ByVal lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
    Private Declare Function SetConsoleTitle Lib "kernel32" Alias "SetConsoleTitleA" (ByVal lpConsoleTitle As String) As Long
'    Private Declare Function AttachConsole Lib "kernel32.dll" (ByVal ProcessID As Integer) As Boolean
'    Private Declare Function SetConsoleTextAttribute Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal wAttributes As Long) As Long
    
    ''GetStdHandle函数的 nStdHandle参数的取值
    Private Const STD_INPUT_HANDLE = -10&
    Private Const STD_OUTPUT_HANDLE = -11&
    Private Const STD_ERROR_HANDLE = -12&
 
    Private hConsoleIn As Long ''控制台窗口的 input handle
    Private hConsoleOut As Long ''控制台窗口的output handle
    Private hConsoleErr As Long ''控制台窗口的error handle

    ''主程序
    Private Sub Main()
 
      Dim szUserInput As String
 
      Call AllocConsole    '创建 console window
      ' AttachConsole(-1)  '如果在命令提示符下运行，返回False，可以加上这个判断以决定上一句是否执行。如果直接附加到DOS窗口，输出消息没事，但要接收输入好像打了回车要说命令不能识别。
      Call SetConsoleTitle("VB控制台应用程序")  '设置console window的标题，也可以不设，显得个性嘛，前景色也可以改哦。

      '取得console window的三个句柄
      hConsoleIn = GetStdHandle(STD_INPUT_HANDLE)
      hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
      hConsoleErr = GetStdHandle(STD_ERROR_HANDLE)
 
      'Call SetConsoleTextAttribute(hConsoleOut, &H4)    '将前景设置为红色，更个性

      Call ConsolePrint("请输入您的姓名：")
      szUserInput = ConsoleRead()
 
      If Not szUserInput = vbNullString Then
         ConsolePrint "您好：" & szUserInput & vbCrLf
      Else
         ConsolePrint "没有名字啊！" & vbCrLf
      End If
 
      ConsolePrint vbCrLf & "演示结束，请按回车退出。"
      Call ConsoleRead '暂停作用，等待按回车。
      Call FreeConsole '销毁 console window

    End Sub
 
    '函数或过程
    Private Sub ConsolePrint(szOut As String)
        WriteConsole hConsoleOut, ByVal szOut, Len(szOut) * 2, vbNull, vbNull
    End Sub
 
    Private Function ConsoleRead() As String
        Dim sUserInput As String * 256
        Call ReadConsole(hConsoleIn, sUserInput, Len(sUserInput), vbNull, vbNull)
        ''截掉字符串结尾的&H00和回车、换行符
        ConsoleRead = Left$(sUserInput, InStr(sUserInput, Chr$(0)) - 3)
    End Function