还是上面两位老师提醒了我： HOWTO: Attach a Console Window to Your Visual Basic Program -------------------------------------------------------------------------------- The information in this article applies to:Microsoft Visual Basic Learning, Professional, and Enterprise Editions for Windows, version 6.0 Microsoft Visual Basic Control Creation, Learning, Professional, and Enterprise Editions for Windows, version 5.0 Microsoft Visual Basic Standard, Professional, and Enterprise Editions, 32-bit only, for Windows, version 4.0-------------------------------------------------------------------------------- SUMMARY This article demonstrates attaching a console window to your Visual Basic application, writing to it, and running another application in the console window. MORE INFORMATION If a Visual Basic application is started from a console application, the operating system automatically detaches it from the console, preventing the Visual Basic application from interacting with it. This article does not provide a method to prevent this from happening, but does demonstrate creating a new console window that your application can interact with. It also demonstrates running a console application (batch file, in this case) from Visual Basic, which utilizes the created console. WARNING: ANY USE BY YOU OF THE CODE PROVIDED IN THIS ARTICLE IS AT YOUR OWN RISK. Microsoft provides this code "as is" without warranty of any kind, either express or implied, including but not limited to the implied warranties of merchantability and/or fitness for a particular purpose. Step-by-Step Example Use Notepad to create the following batch file:DIR /W and save it as C:\TEST.BAT In Visual Basic, create a new project with a form and a module. Type the following API declarations in the module: Option Explicit Declare Function AllocConsole Lib "kernel32" () As Long Declare Function FreeConsole Lib "kernel32" () As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) _ As Long Declare Function GetStdHandle Lib "kernel32" (ByVal _ nStdHandle As Long) As Long 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 Public Const STD_OUTPUT_HANDLE = -11& Add a CommandButton to the form and enter the following code: Dim hConsole As Long 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 Run the application. A blank console window will appear. Click the CommandButton. Both the text in sOut and the output from the batch file will appear in the console. Close the form. The console window will terminate. NOTES: If you run another application in the console, it will run asynchronously with your Visual Basic application. Output from the two applications can become interspersed. If the console application hasn't terminated prior to your Visual Basic application closing, the console window will remain open. If you close the console window, the Visual Basic EXE will terminate. If you are in the Visual Basic development environment (IDE), closing the console window will terminate the IDE and it may hang the console window. Use the Task Manager to terminate the task.
HOWTO: Redirect Standard I/O of a Console App Using Batch File -------------------------------------------------------------------------------- The information in this article applies to:Microsoft Visual Basic Professional and Enterprise Editions, 32-bit only, for Windows, version 4.0-------------------------------------------------------------------------------- SUMMARY A 32-bit Visual Basic application launches another Win32 process by using either the Visual Basic Shell command or the CreateProcess Win32 API. If the new process is a console application that reads its input from the standard input (STDIN) or writes its results to the standard output (STDOUT), you can redirect its input and output from the parent Visual Basic application. This article describes how to use a batch file (.BAT) to redirect the standard input and output of the spawned console process. To build the sample code in this article, you need the 32-bit edition of Visual Basic and any development tools, such as Visual C++ version 2.0 and above, that build Win32 console applications. MORE INFORMATION After the parent Visual Basic application spawns the child console process, the parent Visual Basic application provides input to the child's STDIN and receives the output from the child's STDOUT. By using a batch file, the parent Visual Basic application provides the child's STDIN through a disk file and collects the child's STDOUT through another disk file. Step-by-Step Example Create a console application, CONSOL.EXE, that expects an integer as its STDIN and sends a text string out as its STDOUT, using the following C code: #include <stdio.h> void main(void) { int i; scanf("%d", &i); printf("\nSTDIn is %d!\n", i); } Create a batch file, named REDIRECT.BAT, that contains only the following command line: type stdin.txt | consol.exe > stdout.txt Create a new text file using Notepad or any text editor. Enter an integer and press the ENTER key. Save the file as "stdin.txt." Start a new project in Visual Basic. Form1 is created by default. Add the following code to the General Declarations section of Form1: Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal _ dwAccess As Long, ByVal fInherit As Integer, ByVal hObject _ As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal _ hObject As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _ hHandle As Long, ByVal dwMilliseconds As Long) As Long Const SYNCHRONIZE = &H100000 Const NORMAL_PRIORITY_CLASS = &H20& Const INFINITE = -1& Add the following code to the Form1_Click event: ProcessID& = Shell("test.bat", vbNormalFocus) ProcessHandle& = OpenProcess(SYNCHRONIZE, True, ProcessID&) WaitForSingleObject ProcessHandle&, -1& CloseHandle ProcessHandle& Save Form1 and Project1 to the same directory as REDIRECT.BAT and CONSOL.EXE. Press the F5 key to run the program. Click Form1. A console window is displayed briefly and closes itself. The STDOUT.TXT file is then created in the same directory.
用VB建立字符界面的控制台程序一、概述 即使是初学VB的人，对于如何用它来建立一个GUI界面的标准Windows应用程序，肯定也是胸有成竹；然而，对于如何用VB来编写字符界面的控制台程序（Console－Mode Applications），知道的人恐怕不多。有人甚至认为这是不可能的，因为VB对编写控制台程序并无内在的支持，在VB的“新建工程”对话框里没有“控制台程序”这一选项。实际上，利用Windows提供的应用程序编程接口(API)，VB是能够建立控制台程序的。控制台程序与图形界面的标准Windows程序不同，它没有Windows程序所通行的窗口，其与用户的交互是基于字符界面，外观类似于“MS-DOS方式”，如图1所示。 图1 本文示例程序的运行结果 同标准的Windows程序相比，控制台程序具有界面简单、占内存少、生成的可执行文件小的优点，因而在某些场合还有用武之地。二、具体步骤 由于VB对建立控制台程序并无内在支持，全部工作都是依靠调用API函数来完成，故首先要用VB建立一个新的“标准EXE”工程，并删除其默认窗体(Form1)，添加一标准模块(Module1)，将其改名为VBConsole.bas，后续的所有工作都是在此模块中完成的。 下面按功能分类逐一介绍本文用到的API函数。 1．创建和销毁控制台窗口（consol window）用VB创建控制台程序的第一步就是为VB程序创建一个console window，并在程序结束时销毁它。这分别用到AllocConsole和FreeConsole函数。 Private Declare Function AllocConsole Lib "kernel32"() As Long 功能：为VB程序创建一个 console window。 Private Declare Function FreeConsole Lib "kernel32"() AS Long 功能：销毁为VB程序创建的 console window。 2．取得所建立的 console window 的句柄(Handle) DOS程序有三个标准文件：标准输入文件(stdin)，标准输出文件(stdout)，标准错误文件(siderr)。与此类似，控制台程序窗口有三个句柄： 输入句柄(input handle) - 指向控制台程序的输入缓冲区 输出句柄(output handle)、错误句柄(error handle)- 指向控制台程序的屏幕输出缓冲区 在能够进行输入／输出操作之前，必须用 GetstdHandle 函数取得 console window 的这三个句柄。 Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long 功能：返回 console window 的三个句柄之一。 说明：参数nStdHandle决定此函数返回的是哪一个句柄，它可以取如下值之一： Private Const STD_INPUT_HANDLE = -10& '返回 input handle Private Const TD_OUTPUT_HANDLE = - 11& '返回 output handle Private Const STD_ERROR_HANDLE = -12& '返回 error handle 3．控制台输入／输出创建了 console window 并获得其 input/output handle 后，就可以利用WriteConsole和ReadConsole进行输入/输出了。 Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" _ (ByVal hConsoleoutput As Long，ByVal lpBuffer As Any, ByVal nNumberofCharsTowrite _ As Long, IpNumberofCharsWritten As Long, lpReserved As Any) As Long 功能：向控制台窗口输出字符串。 说明：hConsoleOutput-控制台的outputhandle。 lpBuffer-要输出的字符串。 nNumberOfCharsToWrite-要输出的字符串的长度。 lpNumberofCharsWritten-实际输出的字符串的长度，可置为vbNull。 lpReserved-保留，必须置为vbNul。 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 功能：从输入缓冲区输入字符串。 说明：此函数是以块方式输入信息。在本文的示例中，只有用户按了Enter（回车）键后，此函数才返回。 hConsoleInput-console window的input handle。 lpBuffer-输入缓冲区地址。 nNumberOfCharsToRead-输入缓冲区的长度。 lpNumberOfCharsRead-实际读入的字符数，可置为vbNull。 lpReserved-保留，必须置为vbNull。 Private Declare Function SetConsoleMode Lib "kernel32" (ByVal hConsoleHandle _ As Long, dwMode As Long) As Long 功能：设置控制台输入缓冲区的输人模式或屏幕输出缓冲区的输出模式。 说明：在用 ReadConsole和 WriteConsole函数行输入／输出前，要用此函数设置好输入／输出模式。 hConsoleHandle-console window的Input handle或output handle。 dwMode是要设置的输入或输出模式值。hConsoleHandle是Input handle时， dwMode可取如下值的组合： 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 当 hConsoleHandle 是 output handle 时，dwMode可取如下值的组合： Private Const ENABLE_PROCESSED_OUTPUT = &H1 Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2 这些取值的具体意义，请参见 WINDOWS SDK 文档，此处不再详述。 注意：VB的API浏览器对WriteConsole和ReadConsole两函数的声明是不对的。尽管lpBuffer为长指针，它仍然应为传值调用，这是由于VB和API对字符串的存储和处理方式不一致造成的。 4．其他API函数 有了l、2、3所述的API函数，就可以创建一个基本的控制台程序了。当然，我们还可以用如下的API函数再“修饰”一下呆板的控制台窗口。 Private Declare Function SetConsoleTitle_Lib "kernel32"Alias "SetConsoleTitleA" _ (ByVal lpConsoleTitle As String) As Long 功能：设置控制台窗口的标题。 说明：lpConsoeTitle-要设置的窗口标题（字符串）。 Private Declare Functon SetConsoleTextAttribute Lib "hernel32" _ (ByVal hConsoleOutput As Long, ByVal wAttributes As Long) As Long 功能：设置要在控制台窗口输出的字符的前景色和背景色 说明: hConsoleOutput-控制台窗口的output handle wAttributes-决定了console window的前景色和背景色，可以是如下数值的组合： 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 '背景：高亮度 例如，要设置前景色为黄色，可定义如下的常量并将其赋值给 wAttributes。 Private Const FOREGROUND_YELLOW = FOREGROUND_RED Or FOREGROUND_GREEN三、程序清单 示例程序将创建一个控制台窗口，并输出提示信息，要用户输入自己的url。用户输入名字后，程序输出问候信息，并等待用户按键返回。本文的示例程序在VB5.0中文版下调试通过。 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 '
试了各位的方法，我的理解是：VB可以用API产生控制台窗口，却不能完全真正生成控制台程序（运行在控制台下的程序）。如： 我希望的是： 在一个已经打开的控制台中，输入： C:\vbConsole.exe 程序输出“Input your Name …… 然后可以输入一个字符串……但用以上各位介绍的方法程序的结果是弹出了另一个控制台窗体（在程序中用AllocConsole()函数，将产生一个控制台窗体） 然而，在VC或Delphi中建立的控制台程序，却不存在这样的问题。这个总是如何解决呢？
VB调用API函数建立控制台窗口上随着软件的界面设计的发展，人机交互的方式同过去也有了很大的不同，图形用户 界面，鼠标操作甚至语音等早已经率见不先了。但是在有一些程序中，还是要使用到 象过去那种老式的主机——终端那样的字符型控制台窗口式样的界面。而实际上，在 Windows中也保留了这样的一系列控制台函数，下面的范例演示了如何建立控制台窗口 以及让用户在其中输入字符同计算机进行交互对话。 首先在选VB菜单中的 Project | Module 项向工程文件中加入一个模块，然后在 这个Module中加入以下代码：Option ExplicitPrivate Declare Function AllocConsole Lib "kernel32" () As LongPrivate Declare Function FreeConsole Lib "kernel32" () As LongPrivate Declare Function GetStdHandle Lib "kernel32" _ (ByVal nStdHandle As Long) As LongPrivate 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 LongPrivate Declare Function SetConsoleMode Lib "kernel32" (ByVal _ hConsoleOutput As Long, dwMode As Long) As LongPrivate Declare Function SetConsoleTextAttribute Lib _ "kernel32" (ByVal hConsoleOutput As Long, ByVal _ wAttributes As Long) As LongPrivate Declare Function SetConsoleTitle Lib "kernel32" Alias _ "SetConsoleTitleA" (ByVal lpConsoleTitle As String) As LongPrivate 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 LongPrivate 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 以上代码来自： 源代码数据库(SourceDataBase) 当前版本： 1.0.448 作者： Shawls 个人主页： Http://Shawls.Yeah.Net E-Mail： [email protected] QQ： 9181729
VB调用API函数建立控制台窗口下'''''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 SubPrivate Function ConsoleRead() As String Dim sUserInput As String * 256
Call ReadConsole(hConsoleIn, sUserInput, Len(sUserInput), vbNull, vbNull) 'Trim off the NULL charactors and the CRLF. ConsoleRead = Left$(sUserInput, InStr(sUserInput, Chr$(0)) - 3) End Function 选VB菜单中的 Project | Project1 Properties项，将Startup Object改变为Sub Main，然后 运行程序，程序就会弹出一个控制台窗口，用户可以根据控制台窗口中的提示信息与程序进行交互 对话。 上面的程序在Win98、VB6下运行通过。 以上代码来自： 源代码数据库(SourceDataBase) 当前版本： 1.0.448 作者： Shawls 个人主页： Http://Shawls.Yeah.Net E-Mail： [email protected] QQ： 9181729
我的网站上去看看. http://sanjianxia.myrice.com
我的问题是：当我已经在某一控制台下执行程序时，我并不想重新建立一个控制台。可是，各位的程序都会又重新弹出一个控制台窗口！ 如： （我已经在命令行模式下：） C：>TEST\VBConsole.exe Input a String -------------这里要在同一个控制台窗口中！！而不是又弹出一个新的控制台！！！！
procedure ScrollViewWindow(hBuf: THandle; bUp: Boolean); var rectNew: TSmallRect; begin if bUp then rectNew.Top := -1 else rectNew.Top := 1; rectNew.Bottom := rectNew.Top; rectNew.Left := 0; rectNew.Right := 0;
SetConsoleWindowInfo(hBuf, False, rectNew); end;
procedure SwitchConsole; begin if hActive = hOriginal then begin SetConsoleActiveScreenBuffer(hSecond); hActive := hSecond; end else begin SetConsoleActiveScreenBuffer(hOriginal); hActive := hOriginal; end; end;
{ *** Windows 95/98: 从此处注释掉... } if not SetConsoleScreenBufferSize(hSecond, coorNew) then WriteLn('error: SetConsoleScreenBufferSize() == ', GetLastError) else WriteLn('已经调整第二个屏幕缓冲尺寸。');
if not SetConsoleWindowInfo(hSecond, True, rectView) then WriteLn('error: SetConsoleWindowInfo() == ', GetLastError) else WriteLn('Adjusted secondary screen buffer window.'); { *** ...一直注释到这里 }
FillOutputBuffer(hSecond); { 处理输入循环。} while not bQuit do begin ReadConsoleInput(hInput, arrInputRecs[0], 10, dwCount); for dwCur := 0 to dwCount - 1 do begin case arrInputRecs[dwCur].EventType of KEY_EVENT: with arrInputRecs[dwCur].Event.KeyEvent do if bKeyDown then if (dwControlKeyState and ENHANCED_KEY) > 9 then case wVirtualKeyCode of VK_UP : ScrollViewWindow(hActive, True); VK_DOWN : ScrollViewWindow(hActive, False); end else case Ord(AsciiChar) of 13: SwitchConsole; Ord('?'): begin WriteLn('控制台命令 '); WriteLn(' ? - 简略帮助'); WriteLn(' C - 清除第二个输出缓冲。'); WriteLn(' F - 填充第二个输出缓冲。'); WriteLn(' Q - 退出程序。'); WriteLn(' <ent> - 切换活动屏幕缓冲。'); WriteLn(' <up> - 上卷。'); WriteLn(' <dn> - 下卷。'); end; Ord('C'): ClearOutputBuffer(hSecond); Ord('F'): FillOutputBuffer(hSecond); Ord('Q'): bQuit := True; end; // case Ord(AsciiChar)... end; // case arrInputRecs... end; // for dwCur... end; // while not bQuit... CloseHandle(hSecond); FreeConsole; end. 代码段二 控制句柄 Program ControlHandlers; {$APPTYPE CONSOLE} uses Windows;
var bHandler1, bHandler2: Boolean; nHandler1, nHandler2: Integer; hStdOutput, hStdInput: THandle; arrInputRecs: array[0..9] of TInputRecord; dwCur, dwCount: DWORD; cCur: Char;
while True do begin ReadConsoleInput(hStdInput, arrInputRecs[0], 10, dwCount); for dwCur := 0 to dwCount - 1 do case arrInputRecs[dwCur].EventType of KEY_EVENT: with arrInputRecs[dwCur].Event.KeyEvent do begin cCur := AsciiChar; if (not bKeyDown) and (cCur = '1') then begin bHandler1 := not bHandler1; PaintScreen; end; if (not bKeydown) and (cCur = '2') then begin bHandler2 := not bHandler2; PaintScreen; end; end; end; end; end.
HOWTO: Attach a Console Window to Your Visual Basic Program --------------------------------------------------------------------------------
The information in this article applies to:Microsoft Visual Basic Learning, Professional, and Enterprise Editions for Windows, version 6.0
Microsoft Visual Basic Control Creation, Learning, Professional, and Enterprise Editions for Windows, version 5.0
Microsoft Visual Basic Standard, Professional, and Enterprise Editions, 32-bit only, for Windows, version 4.0--------------------------------------------------------------------------------
SUMMARY
This article demonstrates attaching a console window to your Visual Basic application, writing to it, and running another application in the console window. MORE INFORMATION
If a Visual Basic application is started from a console application, the operating system automatically detaches it from the console, preventing the Visual Basic application from interacting with it. This article does not provide a method to prevent this from happening, but does demonstrate creating a new console window that your application can interact with. It also demonstrates running a console application (batch file, in this case) from Visual Basic, which utilizes the created console. WARNING: ANY USE BY YOU OF THE CODE PROVIDED IN THIS ARTICLE IS AT YOUR OWN RISK. Microsoft provides this code "as is" without warranty of any kind, either express or implied, including but not limited to the implied warranties of merchantability and/or fitness for a particular purpose.
Step-by-Step Example
Use Notepad to create the following batch file:DIR /W and save it as C:\TEST.BAT
In Visual Basic, create a new project with a form and a module.
Type the following API declarations in the module:
Option Explicit Declare Function AllocConsole Lib "kernel32" () As Long
Declare Function FreeConsole Lib "kernel32" () As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) _
As Long
Declare Function GetStdHandle Lib "kernel32" (ByVal _
nStdHandle As Long) As Long
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 Public Const STD_OUTPUT_HANDLE = -11&
Add a CommandButton to the form and enter the following code:
Dim hConsole As Long 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
Run the application. A blank console window will appear.
Click the CommandButton. Both the text in sOut and the output from the batch file will appear in the console.
Close the form. The console window will terminate.
NOTES: If you run another application in the console, it will run asynchronously with your Visual Basic application. Output from the two applications can become interspersed.
If the console application hasn't terminated prior to your Visual Basic application closing, the console window will remain open.
If you close the console window, the Visual Basic EXE will terminate. If you are in the Visual Basic development environment (IDE), closing the console window will terminate the IDE and it may hang the console window. Use the Task Manager to terminate the task.
The information in this article applies to:Microsoft Visual Basic Professional and Enterprise Editions, 32-bit only, for Windows, version 4.0--------------------------------------------------------------------------------
SUMMARY
A 32-bit Visual Basic application launches another Win32 process by using either the Visual Basic Shell command or the CreateProcess Win32 API. If the new process is a console application that reads its input from the standard input (STDIN) or writes its results to the standard output (STDOUT), you can redirect its input and output from the parent Visual Basic application. This article describes how to use a batch file (.BAT) to redirect the standard input and output of the spawned console process. To build the sample code in this article, you need the 32-bit edition of Visual Basic and any development tools, such as Visual C++ version 2.0 and above, that build Win32 console applications. MORE INFORMATION
After the parent Visual Basic application spawns the child console process, the parent Visual Basic application provides input to the child's STDIN and receives the output from the child's STDOUT. By using a batch file, the parent Visual Basic application provides the child's STDIN through a disk file and collects the child's STDOUT through another disk file.
Step-by-Step Example
Create a console application, CONSOL.EXE, that expects an integer as its STDIN and sends a text string out as its STDOUT, using the following C code: #include <stdio.h> void main(void)
{
int i;
scanf("%d", &i);
printf("\nSTDIn is %d!\n", i);
}
Create a batch file, named REDIRECT.BAT, that contains only the following command line: type stdin.txt | consol.exe > stdout.txt
Create a new text file using Notepad or any text editor. Enter an integer and press the ENTER key. Save the file as "stdin.txt."
Start a new project in Visual Basic. Form1 is created by default.
Add the following code to the General Declarations section of Form1: Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal _
dwAccess As Long, ByVal fInherit As Integer, ByVal hObject _
As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal _
hObject As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long Const SYNCHRONIZE = &H100000
Const NORMAL_PRIORITY_CLASS = &H20&
Const INFINITE = -1&
Add the following code to the Form1_Click event: ProcessID& = Shell("test.bat", vbNormalFocus)
ProcessHandle& = OpenProcess(SYNCHRONIZE, True, ProcessID&)
WaitForSingleObject ProcessHandle&, -1&
CloseHandle ProcessHandle&
Save Form1 and Project1 to the same directory as REDIRECT.BAT and CONSOL.EXE. Press the F5 key to run the program. Click Form1. A console window is displayed briefly and closes itself. The STDOUT.TXT file is then created in the same directory.
即使是初学VB的人，对于如何用它来建立一个GUI界面的标准Windows应用程序，肯定也是胸有成竹；然而，对于如何用VB来编写字符界面的控制台程序（Console－Mode Applications），知道的人恐怕不多。有人甚至认为这是不可能的，因为VB对编写控制台程序并无内在的支持，在VB的“新建工程”对话框里没有“控制台程序”这一选项。实际上，利用Windows提供的应用程序编程接口(API)，VB是能够建立控制台程序的。控制台程序与图形界面的标准Windows程序不同，它没有Windows程序所通行的窗口，其与用户的交互是基于字符界面，外观类似于“MS-DOS方式”，如图1所示。
图1 本文示例程序的运行结果 同标准的Windows程序相比，控制台程序具有界面简单、占内存少、生成的可执行文件小的优点，因而在某些场合还有用武之地。二、具体步骤
由于VB对建立控制台程序并无内在支持，全部工作都是依靠调用API函数来完成，故首先要用VB建立一个新的“标准EXE”工程，并删除其默认窗体(Form1)，添加一标准模块(Module1)，将其改名为VBConsole.bas，后续的所有工作都是在此模块中完成的。
下面按功能分类逐一介绍本文用到的API函数。
1．创建和销毁控制台窗口（consol window）用VB创建控制台程序的第一步就是为VB程序创建一个console window，并在程序结束时销毁它。这分别用到AllocConsole和FreeConsole函数。
Private Declare Function AllocConsole Lib "kernel32"() As Long
功能：为VB程序创建一个 console window。
Private Declare Function FreeConsole Lib "kernel32"() AS Long
功能：销毁为VB程序创建的 console window。
2．取得所建立的 console window 的句柄(Handle)
DOS程序有三个标准文件：标准输入文件(stdin)，标准输出文件(stdout)，标准错误文件(siderr)。与此类似，控制台程序窗口有三个句柄：
输入句柄(input handle) - 指向控制台程序的输入缓冲区
输出句柄(output handle)、错误句柄(error handle)- 指向控制台程序的屏幕输出缓冲区
在能够进行输入／输出操作之前，必须用 GetstdHandle 函数取得 console window 的这三个句柄。
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
功能：返回 console window 的三个句柄之一。
说明：参数nStdHandle决定此函数返回的是哪一个句柄，它可以取如下值之一：
Private Const STD_INPUT_HANDLE = -10& '返回 input handle
Private Const TD_OUTPUT_HANDLE = - 11& '返回 output handle
Private Const STD_ERROR_HANDLE = -12& '返回 error handle
3．控制台输入／输出创建了 console window 并获得其 input/output handle 后，就可以利用WriteConsole和ReadConsole进行输入/输出了。
Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" _
(ByVal hConsoleoutput As Long，ByVal lpBuffer As Any, ByVal nNumberofCharsTowrite _
As Long, IpNumberofCharsWritten As Long, lpReserved As Any) As Long
功能：向控制台窗口输出字符串。
说明：hConsoleOutput-控制台的outputhandle。
lpBuffer-要输出的字符串。
nNumberOfCharsToWrite-要输出的字符串的长度。
lpNumberofCharsWritten-实际输出的字符串的长度，可置为vbNull。
lpReserved-保留，必须置为vbNul。
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
功能：从输入缓冲区输入字符串。
说明：此函数是以块方式输入信息。在本文的示例中，只有用户按了Enter（回车）键后，此函数才返回。
hConsoleInput-console window的input handle。
lpBuffer-输入缓冲区地址。
nNumberOfCharsToRead-输入缓冲区的长度。
lpNumberOfCharsRead-实际读入的字符数，可置为vbNull。
lpReserved-保留，必须置为vbNull。
Private Declare Function SetConsoleMode Lib "kernel32" (ByVal hConsoleHandle _
As Long, dwMode As Long) As Long
功能：设置控制台输入缓冲区的输人模式或屏幕输出缓冲区的输出模式。
说明：在用 ReadConsole和 WriteConsole函数行输入／输出前，要用此函数设置好输入／输出模式。
hConsoleHandle-console window的Input handle或output handle。
dwMode是要设置的输入或输出模式值。hConsoleHandle是Input handle时， dwMode可取如下值的组合：
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
当 hConsoleHandle 是 output handle 时，dwMode可取如下值的组合：
Private Const ENABLE_PROCESSED_OUTPUT = &H1
Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2
这些取值的具体意义，请参见 WINDOWS SDK 文档，此处不再详述。
注意：VB的API浏览器对WriteConsole和ReadConsole两函数的声明是不对的。尽管lpBuffer为长指针，它仍然应为传值调用，这是由于VB和API对字符串的存储和处理方式不一致造成的。
4．其他API函数
有了l、2、3所述的API函数，就可以创建一个基本的控制台程序了。当然，我们还可以用如下的API函数再“修饰”一下呆板的控制台窗口。
Private Declare Function SetConsoleTitle_Lib "kernel32"Alias "SetConsoleTitleA" _
(ByVal lpConsoleTitle As String) As Long
功能：设置控制台窗口的标题。
说明：lpConsoeTitle-要设置的窗口标题（字符串）。
Private Declare Functon SetConsoleTextAttribute Lib "hernel32" _
(ByVal hConsoleOutput As Long, ByVal wAttributes As Long) As Long
功能：设置要在控制台窗口输出的字符的前景色和背景色
说明: hConsoleOutput-控制台窗口的output handle
wAttributes-决定了console window的前景色和背景色，可以是如下数值的组合：
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 '背景：高亮度
例如，要设置前景色为黄色，可定义如下的常量并将其赋值给 wAttributes。
Private Const FOREGROUND_YELLOW = FOREGROUND_RED Or FOREGROUND_GREEN三、程序清单
示例程序将创建一个控制台窗口，并输出提示信息，要用户输入自己的url。用户输入名字后，程序输出问候信息，并等待用户按键返回。本文的示例程序在VB5.0中文版下调试通过。
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 '
我希望的是：
在一个已经打开的控制台中，输入：
C:\vbConsole.exe
程序输出“Input your Name ……
然后可以输入一个字符串……但用以上各位介绍的方法程序的结果是弹出了另一个控制台窗体（在程序中用AllocConsole()函数，将产生一个控制台窗体）
然而，在VC或Delphi中建立的控制台程序，却不存在这样的问题。这个总是如何解决呢？
当然，收到后别忘了给分哟！:)
界面，鼠标操作甚至语音等早已经率见不先了。但是在有一些程序中，还是要使用到
象过去那种老式的主机——终端那样的字符型控制台窗口式样的界面。而实际上，在
Windows中也保留了这样的一系列控制台函数，下面的范例演示了如何建立控制台窗口
以及让用户在其中输入字符同计算机进行交互对话。
首先在选VB菜单中的 Project | Module 项向工程文件中加入一个模块，然后在
这个Module中加入以下代码：Option ExplicitPrivate Declare Function AllocConsole Lib "kernel32" () As LongPrivate Declare Function FreeConsole Lib "kernel32" () As LongPrivate Declare Function GetStdHandle Lib "kernel32" _
(ByVal nStdHandle As Long) As LongPrivate 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 LongPrivate Declare Function SetConsoleMode Lib "kernel32" (ByVal _
hConsoleOutput As Long, dwMode As Long) As LongPrivate Declare Function SetConsoleTextAttribute Lib _
"kernel32" (ByVal hConsoleOutput As Long, ByVal _
wAttributes As Long) As LongPrivate Declare Function SetConsoleTitle Lib "kernel32" Alias _
"SetConsoleTitleA" (ByVal lpConsoleTitle As String) As LongPrivate 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 LongPrivate 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
以上代码来自： 源代码数据库(SourceDataBase)
当前版本： 1.0.448
作者： Shawls
个人主页： Http://Shawls.Yeah.Net
E-Mail： [email protected]
QQ： 9181729
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 SubPrivate Function ConsoleRead() As String
Dim sUserInput As String * 256
Call ReadConsole(hConsoleIn, sUserInput, Len(sUserInput), vbNull, vbNull)
'Trim off the NULL charactors and the CRLF.
ConsoleRead = Left$(sUserInput, InStr(sUserInput, Chr$(0)) - 3)
End Function
选VB菜单中的 Project | Project1 Properties项，将Startup Object改变为Sub Main，然后
运行程序，程序就会弹出一个控制台窗口，用户可以根据控制台窗口中的提示信息与程序进行交互
对话。
上面的程序在Win98、VB6下运行通过。
以上代码来自： 源代码数据库(SourceDataBase)
当前版本： 1.0.448
作者： Shawls
个人主页： Http://Shawls.Yeah.Net
E-Mail： [email protected]
QQ： 9181729
http://sanjianxia.myrice.com
如：
（我已经在命令行模式下：）
C：>TEST\VBConsole.exe
Input a String -------------这里要在同一个控制台窗口中！！而不是又弹出一个新的控制台！！！！
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 "Enter your url:"
szUserInput = ConsoleRead()
If Not szUserInput = vbNullString Then
ConsolePrint "Hello, " & szUserInput & "!" & vbCrLf
Else
ConsolePrint "You don't have a url?" & vbCrLf
End If
ConsolePrint vbCrLf & "Press enter to exit!"
Call ConsoleRead
FreeConsole '销毁 console window
End Sub'程序中用到的子函数
Private Sub ConsolePrint(szOut As String)
WriteConsole hConsoleOut, szOut, Len(szOut), vbNull, vbNull
End SubPrivate 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
TechnoFantasy说：
"你指的是建立Console application，而不是在程序中建立一个控制台窗口。这个VB应该是办不到的。"
我认为他说得对（不愧是五星级的），当然这个问题也没什么实际价值，只想深入了解一下而已。不然谁做一个符合我要求的例子。
我再等一二天，如果没有异议，我就给分了。
=============================================================
代码段一 屏幕缓冲区
program ScreenBuffers;
uses
Windows, SysUtils;
var
hInput, hOriginal, hSecond, hActive: THandle;
arrInputRecs : array[0..9] of TInputRecord;
dwCount, dwCur : DWORD;
bQuit : Boolean = False;
coorNew : TCoord = (X:100; Y:100);
rectView: TSmallRect =
(Left:0; Top:0; Right:99; Bottom:49);
const
OUTPUT_STRING =
'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890!@#$%^&*()[]{}';
FOREGROUND_MAGENTA = FOREGROUND_RED or FOREGROUND_BLUE;
FOREGROUND_BR_MAGENTA =
FOREGROUND_MAGENTA or FOREGROUND_INTENSITY;
procedure WriteToScreen(buf: String);
var
dwCount: DWORD;
begin
buf := buf + #13#10;
WriteConsole(hActive, PChar(@buf[1]), Length(buf),
dwCount, nil);
end;
procedure FillOutputBuffer(hBuf: THandle);
var
dwAttr, dwCur: DWORD;
begin
dwAttr := 0;
for dwCur := 0 to 100 do begin
SetConsoleTextAttribute(hSecond, dwAttr + 1);
WriteConsole(hSecond, PChar(@OUTPUT_STRING[1]),
Length(OUTPUT_STRING), dwCount, nil);
dwAttr := (dwAttr + 1) mod 15;
end;
Writeln('第二个缓冲用数据填充。');
end;
procedure ClearOutputBuffer(hBuf: THandle);
var
cbsi: TConsoleScreenBufferInfo;
coorClear: TCoord;
dwWritten: DWORD;
cFill: Char;
begin
GetConsoleScreenBufferInfo(hBuf, cbsi);
coorClear.X := 0;
coorClear.Y := 0;
cFill := ' ';
FillConsoleOutputCharacter(hBuf, cFill,
cbsi.dwSize.X * cbsi.dwSize.Y, coorClear, dwWritten);
end;
procedure ScrollViewWindow(hBuf: THandle; bUp: Boolean);
var
rectNew: TSmallRect;
begin
if bUp then
rectNew.Top := -1
else
rectNew.Top := 1;
rectNew.Bottom := rectNew.Top;
rectNew.Left := 0;
rectNew.Right := 0;
SetConsoleWindowInfo(hBuf, False, rectNew);
end;
procedure SwitchConsole;
begin
if hActive = hOriginal then
begin
SetConsoleActiveScreenBuffer(hSecond);
hActive := hSecond;
end
else
begin
SetConsoleActiveScreenBuffer(hOriginal);
hActive := hOriginal;
end;
end;
begin
{ 首先，释放存在的控制台，创建一个新的。}
FreeConsole;
AllocConsole;
SetConsoleTitle('Screen Buffers Demo');
{ 取得自动创建的输入输出缓冲。}
hInput := GetStdHandle(STD_INPUT_HANDLE);
hOriginal := GetStdHandle(STD_OUTPUT_HANDLE);
hActive := hOriginal;
SetConsoleTextAttribute(hActive, FOREGROUND_BR_MAGENTA);
WriteLn('取得标准输出句柄。');
{ 创建第二个屏幕缓冲。}
hSecond := CreateConsoleScreenBuffer(GENERIC_READ or
GENERIC_WRITE, 0, nil, CONSOLE_TEXTMODE_BUFFER, nil);
{ *** Windows 95/98: 从此处注释掉... }
if not SetConsoleScreenBufferSize(hSecond, coorNew) then
WriteLn('error: SetConsoleScreenBufferSize() == ',
GetLastError)
else
WriteLn('已经调整第二个屏幕缓冲尺寸。');
if not SetConsoleWindowInfo(hSecond, True, rectView) then
WriteLn('error: SetConsoleWindowInfo() == ',
GetLastError)
else
WriteLn('Adjusted secondary screen buffer window.');
{ *** ...一直注释到这里 }
FillOutputBuffer(hSecond);
{ 处理输入循环。}
while not bQuit do begin
ReadConsoleInput(hInput, arrInputRecs[0], 10, dwCount);
for dwCur := 0 to dwCount - 1 do begin
case arrInputRecs[dwCur].EventType of
KEY_EVENT:
with arrInputRecs[dwCur].Event.KeyEvent do
if bKeyDown then
if (dwControlKeyState and
ENHANCED_KEY) > 9 then
case wVirtualKeyCode of
VK_UP :
ScrollViewWindow(hActive, True);
VK_DOWN :
ScrollViewWindow(hActive, False);
end
else
case Ord(AsciiChar) of
13: SwitchConsole;
Ord('?'):
begin
WriteLn('控制台命令 ');
WriteLn(' ? - 简略帮助');
WriteLn(' C - 清除第二个输出缓冲。');
WriteLn(' F - 填充第二个输出缓冲。');
WriteLn(' Q - 退出程序。');
WriteLn(' <ent> - 切换活动屏幕缓冲。');
WriteLn(' <up> - 上卷。');
WriteLn(' <dn> - 下卷。');
end;
Ord('C'): ClearOutputBuffer(hSecond);
Ord('F'): FillOutputBuffer(hSecond);
Ord('Q'): bQuit := True;
end; // case Ord(AsciiChar)...
end; // case arrInputRecs...
end; // for dwCur...
end; // while not bQuit...
CloseHandle(hSecond);
FreeConsole;
end.
代码段二 控制句柄
Program ControlHandlers;
{$APPTYPE CONSOLE}
uses
Windows;
var
bHandler1, bHandler2: Boolean;
nHandler1, nHandler2: Integer;
hStdOutput, hStdInput: THandle;
arrInputRecs: array[0..9] of TInputRecord;
dwCur, dwCount: DWORD;
cCur: Char;
const
FOREGROUND_BR_CYAN = FOREGROUND_BLUE + FOREGROUND_GREEN +
FOREGROUND_INTENSITY;
FOREGROUND_BR_RED = FOREGROUND_RED +
FOREGROUND_INTENSITY;
procedure ClearOutputBuffer;
var
cbsi: TConsoleScreenBufferInfo;
coorClear: TCoord;
dwWritten: DWORD;
cFill: Char;
begin
GetConsoleScreenBufferInfo(hstdOutput, cbsi);
coorClear.X := 0;
coorClear.Y := 0;
cFill := ' ';
FillConsoleOutputCharacter(hStdOutput, cFill,
cbsi.dwSize.X * cbsi.dwSize.Y, coorClear, dwWritten);
end;
procedure PaintScreen;
var
coorHome: TCoord;
begin
coorHome.X := 0; coorHome.Y := 0;
SetConsoleCursorPosition(hStdOutput, coorHome);
SetConsoleTextAttribute(hStdOutput, FOREGROUND_BR_CYAN);
Write('<1> 第一个控制句柄状态：');
SetConsoleTextAttribute(hStdOutput, FOREGROUND_BR_RED);
if bHandler1 then
WriteLn('ON ')
else
WriteLn('OFF');
SetConsoleTextAttribute(hStdOutput, FOREGROUND_BR_CYAN);
Write('<2> 第二个控制句柄状态：');
SetConsoleTextAttribute(hStdOutput, FOREGROUND_BR_RED);
if bHandler2 then
WriteLn('ON ')
else
WriteLn('OFF');
SetConsoleTextAttribute(hStdOutput, FOREGROUND_BR_CYAN);
WriteLn('第一个控制句柄引发 ',
nHandler1, ' 次。');
WriteLn('第二个控制句柄引发 ',
nHandler2, ' 次。');
end;
function Handler1(dwSignal: DWORD): BOOL; stdcall;
begin
Inc(nHandler1);
PaintScreen;
Result := bHandler1;
end;
function Handler2(dwSignal: DWORD): BOOL; stdcall;
begin
Inc(nHandler2);
PaintScreen;
Result := bHandler2;
end;
begin
hStdInput := GetStdHandle(STD_INPUT_HANDLE);
hStdOutput := GetStdHandle(STD_OUTPUT_HANDLE);
{ 反向注册，保证第一句柄先被引发。}
SetConsoleCtrlHandler(@Handler2, True);
SetConsoleCtrlHandler(@Handler1, True);
ClearOutputBuffer;
PaintScreen;
while True do begin
ReadConsoleInput(hStdInput, arrInputRecs[0], 10,
dwCount);
for dwCur := 0 to dwCount - 1 do
case arrInputRecs[dwCur].EventType of
KEY_EVENT:
with arrInputRecs[dwCur].Event.KeyEvent do begin
cCur := AsciiChar;
if (not bKeyDown) and (cCur = '1') then
begin
bHandler1 := not bHandler1;
PaintScreen;
end;
if (not bKeydown) and (cCur = '2') then
begin
bHandler2 := not bHandler2;
PaintScreen;
end;
end;
end;
end;
end.