VB编写控制台应用程序源码示例

方法1：

设计时把窗体移除，加个模块，里面写

Sub Main() Shell "command.com",vbNormalFocus End End Sub

方法2：

或者用Command接受参数
或者用Pipe的API实现一个自己的控制台

设计时把窗体移除，加个模块，里面写

Option Explicit 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,_ lpNumberOfCharsRead As Long,lpReserved As Any) As Long Private Declare Function SetConsoleMode Lib "kernel32" (ByVal _ hConsoleOutput As Long,dwMode As Long) 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 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 Const STD_INPUT_HANDLE = -10& Private Const STD_OUTPUT_HANDLE = -11& Private Const STD_ERROR_HANDLE = -12& Private Const FOREGROUND_BLUE = &H1 Private Const FOREGROUND_GREEN = &H2 Private Const FOREGROUND_RED = &H4 Private Const FOREGROUND_INTENSITY = &H8 Private Const BACKGROUND_BLUE = &H10 Private Const BACKGROUND_GREEN = &H20 Private Const BACKGROUND_RED = &H40 Private Const BACKGROUND_INTENSITY = &H80 'For SetConsoleMode (input) 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 'For SetConsoleMode (output) Private Const ENABLE_PROCESSED_OUTPUT = &H1 Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2 '''''G L O B A L S''''''''''''''''''''''''''''''''''' Private hConsoleIn As Long ' The console's input handle Private hConsoleOut As Long ' The console's output handle Private hConsoleErr As Long ' The console's error handle '''''M A I N''''''''''''''''''''''''''''''''''''''''' Private Sub Main() Dim szUserInput As String AllocConsole '建立一个控制台窗口 SetConsoleTitle "VB Console Example" '设置窗口标题 '获得控制窗口的句柄 hConsoleIn = GetStdHandle(STD_INPUT_HANDLE) hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE) hConsoleErr = GetStdHandle(STD_ERROR_HANDLE) SetConsoleTextAttribute hConsoleOut,_ FOREGROUND_RED Or FOREGROUND_GREEN _ Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY _ Or BACKGROUND_BLUE ConsolePrint "VB Console Example" & vbCrLf SetConsoleTextAttribute hConsoleOut,_ FOREGROUND_RED Or FOREGROUND_GREEN _ Or FOREGROUND_BLUE ConsolePrint "Please Enter Your Name Here--> " '获得用户名 szUserInput = ConsoleRead() If Not szUserInput = vbNullString Then ConsolePrint "Hello," & szUserInput & "!" & vbCrLf Else ConsolePrint "Hello,But who are you?" & vbCrLf End If ConsolePrint "Press Enter To Close The Console" Call ConsoleRead FreeConsole ' Destroy the console End Sub Private Sub ConsolePrint(szOut As String) WriteConsole hConsoleOut,szOut,Len(szOut),vbNull,vbNull End Sub Private Function ConsoleRead() As String Dim sUserInput As String * 256 Call ReadConsole(hConsoleIn,sUserInput,Len(sUserInput),vbNull) 'Trim off the NULL charactors and the CRLF. ConsoleRead = Left$(sUserInput,InStr(sUserInput,Chr$(0)) - 3) End Function

第二种：

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 SetConsoleMode Lib "kernel32" (ByVal hConsoleOutput As Long,_ dwMode As Long) As Long Private Declare Function SetConsoleTitle Lib "kernel32" Alias "SetConsoleTitleA" _ (ByVal lpConsoleTitle As String) As Long Private Declare Function SetConsoleTextAttribute Lib "kernel32" _ (ByVal hConsoleOutput As Long,ByVal wAttributes As Long) As Long '定义API函数中用到的所有常量 'GetStdHandle函数的 nStdHandle参数的取值 Private Const STD_INPUT_HANDLE = -10& Private Const STD_OUTPUT_HANDLE = -11& Private Const STD_ERROR_HANDLE = -12& 'SetConsoleTextAttribute函数的wAttributes参数的取值（按RGB方式组合） Private Const FOREGROUND_bLUE = &H1 Private Const FOREGROUND_GREEN = &H2 Private Const FOREGROUND_RED = &H4 Private Const FOREGROUND_INTENSITY = &H8 Private Const BACKGROUND_BLUE = &H10 Private Const BACKGROUND_GREEN = &H20 Private Const BACKGROUND_RED = &H40 Private Const BACKGROUND_INTENSITY = &H80 'SetConsoleMode的输入模式 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 'SetConsoleMode的输出模式 Private Const ENABLE_PROCESSED_OUTPUT = &H1 Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2 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 AllocConsole '创建 console window SetConsoleTitle "VB控制台应用程序" '设置console window的标题 '取得console window的三个句柄 hConsoleIn = GetStdHandle(STD_INPUT_HANDLE) hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE) hConsoleErr = GetStdHandle(STD_ERROR_HANDLE) SetConsoleTextAttribute hConsoleOut,FOREGROUND_GREEN Or FOREGROUND_INTENSITY '前景：亮绿；背景：黑 ConsolePrint "What's your name?" ConsolePrint vbCrLf szUserInput = ConsoleRead() If Not szUserInput = vbNullString Then ConsolePrint "Hello," & szUserInput & "!" & vbCrLf Else ConsolePrint "You don't have a name?" & vbCrLf End If ConsolePrint vbCrLf & "Press enter to exit!" Call ConsoleRead '暂停住 FreeConsole '销毁 console window End Sub '程序中用到的子函数 Private Sub ConsolePrint(szOut As String) WriteConsole hConsoleOut,vbNull End Sub Private Function ConsoleRead() As String Dim sUserInput As String * 256 Call ReadConsole(hConsoleIn,vbNull) '截掉字符串结尾的&H00和回车、换行符 ConsoleRead = Left$(sUserInput,Chr$(0)) - 3) End Function

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!