Printable View
could someone please tell me if there is a way to get
the handle for the dos console window if a program
is run from the command line instead of from windows?
I want to build a console app (as per the console
tutorial on this site) but want the output to appear
in the dos window that it is run from instead of
in a new console. also, how can i design it so that if
the program was NOT run from a dos console that it will
open a new console window to perform its actions?
A console app will always use the console window it was run in, and windows automatically creates one if it is run from inside windows.
I tried compiling the sample project included in the
tutorial on this site into an exe, and ran it from
a dos window, but it opened a new console instead of
running inside the dos console. The dos console
returned a new dos prompt.
Hmm. Which sample was that? I'll take a look at it and see what's going on.
It's the one that's on the vb-world.net web site.
Here's the code that was given in the tutorial:
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&
'Color values for SetConsoleTextAttribute.
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
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
Private Sub Main()
Dim szUserInput As String
AllocConsole 'Create a console instance
SetConsoleTitle "VB Console Example" 'Set the title on the console window
'Get the console's handle
hConsoleIn = GetStdHandle(STD_INPUT_HANDLE)
hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
hConsoleErr = GetStdHandle(STD_ERROR_HANDLE)
'Print the prompt to the user. Use the vbCrLf to get to a new line.
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 "Enter your name--> "
'Get the user's name
szUserInput = ConsoleRead()
If Not szUserInput = vbNullString Then
ConsolePrint "Hello, " & szUserInput & "!" & vbCrLf
Else
ConsolePrint "Hello, whoever you are!" & vbCrLf
End If
'End the program
ConsolePrint "Press enter to exit"
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, vbNull)
'Trim off the NULL charactors and the CRLF.
ConsoleRead = Left$(sUserInput, InStr(sUserInput, Chr$(0)) - 3)
End Function
Aha. I see now. This example is explicitly creating a console window, rather than working as a console app. I'll see what I can do, and get back to you.
Paste this code into a module and then compile an exe called makevbcon.exe or something like that.
Option Explicit
Option Base 1
DefLng A-Z
Public Declare Function WritePrivateProfileString& Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal FileName$)
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const GENERIC_READ As Long = &H80000000
Private Const OPEN_EXISTING As Long = 3&
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80&
Private Const SCS_32BIT_BINARY = 0&
Private Const SCS_DOS_BINARY = 1&
Private Const SCS_WOW_BINARY = 2&
Private Const SCS_PIF_BINARY = 3&
Private Const SCS_POSIX_BINARY = 4&
Private Const SCS_OS216_BINARY = 5&
Private Const constMsgTitle = "Make Console App"
' ---------------------------------------------
' Windows API calls
' ---------------------------------------------
Public Declare Sub CopyMem _
Lib "kernel32" Alias "RtlMoveMemory" _
(dst As Any, src As Any, ByVal Size As Long)
Private Declare Function CloseHandle _
Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function CreateFile _
Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Public Sub ConvertToConsole(strFileName As String)
Dim strMsg As String
Dim strRtn As String
If Trim$(strFileName) = "" Then
strMsg = "You must enter the name of a VB 5.0 standard executable file."
MsgBox strMsg, vbExclamation, constMsgTitle
Else
If InStr(1, strFileName, ".", vbTextCompare) = 0 Then
strFileName = strFileName & ".EXE"
End If
If Exists(strFileName) = True Then
strRtn = SetConsoleApp(strFileName)
MsgBox strRtn, vbInformation, constMsgTitle
Else
strMsg = "The file, " & Trim$(strFileName) & ", does not exist."
MsgBox strMsg, vbCritical, constMsgTitle
End If
End If
End Sub
Private Function SetConsoleApp(xstrFileName As String) As String
Dim lngFileNum As Long
Dim ststrMZ_Header As String * 512
Dim strMagic As String * 2
Dim strMagicPE As String * 2
Dim lngNewPE_Offset As Long
Dim lngData As Long
Dim strTmp As String
Const PE_FLAG_OFFSET As Long = 93&
Const DOS_FILE_OFFSET As Long = 25&
' ---------------------------------------------
' See if file actually exists
' ---------------------------------------------
strTmp = Trim$(Dir$(xstrFileName))
If Len(strTmp) = 0 Then
SetConsoleApp = "Failed -- The file, " & xstrFileName & ", does not exist!"
GoTo ExitCheck
End If
' ---------------------------------------------
' Get a free file handle
' ---------------------------------------------
On Error Resume Next
lngFileNum = FreeFile
Open xstrFileName For Binary Access Read Write Shared As lngFileNum
' ---------------------------------------------
' Get the first 512 characters from from file
' ---------------------------------------------
Seek #lngFileNum, 1
Get lngFileNum, , ststrMZ_Header
' ---------------------------------------------
' Look for the "magic header" values "MZ"
' If it doesn't exist, then it's not an EXE file
' ---------------------------------------------
If Mid$(ststrMZ_Header, 1, 2) <> "MZ" Then
SetConsoleApp = "Failed -- File is not an executable file."
GoTo ExitCheck
End If
' ---------------------------------------------
' Check to see if it's a MS-DOS executable
' ---------------------------------------------
CopyMem lngData, ByVal Mid$(ststrMZ_Header, DOS_FILE_OFFSET, 2), 2
If lngData < 64 Then
SetConsoleApp = "Failed -- File is 16-bit MSDOS EXE file."
GoTo ExitCheck
End If
' ---------------------------------------------
' Get the offset for the new .EXE header
' ---------------------------------------------
CopyMem lngNewPE_Offset, ByVal Mid$(ststrMZ_Header, 61, 4), 4
' ---------------------------------------------
' Get the "magic" header (NE, LE, PE)
' ---------------------------------------------
strMagic = Mid$(ststrMZ_Header, lngNewPE_Offset + 1, 2)
strMagicPE = Mid$(ststrMZ_Header, lngNewPE_Offset + 3, 2)
Select Case strMagic
' ---------------------------------------------
' Check for NT format
' ---------------------------------------------
Case "PE"
If strMagicPE <> vbNullChar & vbNullChar Then
SetConsoleApp = "Failed -- File is unknown 32-bit NT executable file."
GoTo ExitCheck
End If
' ---------------------------------------------
' Get the subsystem flags to identify NT
' character-mode
' ---------------------------------------------
lngData = Asc(Mid$(ststrMZ_Header, lngNewPE_Offset + PE_FLAG_OFFSET, 1))
If lngData <> 3 Then
On Error Resume Next
Err.Number = 0
Seek #lngFileNum, lngNewPE_Offset + PE_FLAG_OFFSET
Put lngFileNum, , 3
If Err.Number = 0 Then
SetConsoleApp = "Success -- Converted file to console app."
Else
SetConsoleApp = "Failed -- Error converting to console app: " & Err.Description
End If
Else
SetConsoleApp = "Failed -- Already a console app"
End If
Case Else
SetConsoleApp = "Failed -- Not correct file type."
End Select
ExitCheck:
' ---------------------------------------------
' Close the file
' ---------------------------------------------
Close lngFileNum
On Error GoTo 0
End Function
Public Function Exists(ByVal xstrFullName As String) As Boolean
On Error Resume Next ' Don't accept errors here
Const constProcName As String = "Exists"
Dim lngFileHwnd As Long
Dim lngRtn As Long
' ------------------------------------------
' Open the file only if it already exists
' ------------------------------------------
lngFileHwnd = CreateFile(xstrFullName, _
GENERIC_READ, 0&, _
0&, OPEN_EXISTING, _
FILE_ATTRIBUTE_NORMAL, 0&)
' ------------------------------------------
' If get these specific errors, then
' file doesn't exist
' ------------------------------------------
If lngFileHwnd = 0 Or lngFileHwnd = -1 Then
Exists = False
Else
' Success -- Must close the handle
lngRtn = CloseHandle(lngFileHwnd)
Exists = True
End If
On Error GoTo 0
End Function
Public Sub Main()
ConvertToConsole(Command())
End Sub
Then in your console application, remove any AllocConsole or FreeConsole calls.
This code will convert the executable that you compile your console application into, to a standard dos console application which will use the console window in which it was started rather than generating a new one for it.
Thanks, i'll try it.
1. Was that smiley in the message supposed to be there, or was that some code? If it was some code, let me know so I can correct it.
2. Will this work for a VB5 app that has a form in it simply to contain some controls? (I want to make some DOS winsock apps, but need to use the winsock control, and the only way I know how is to put it on a form, load that form, then keep it hidden. If you know of a better way please tell me).
Don't add it to your form, just use
Dim x as Winsock (or whatever)
and then use it as normal. This method can also be used to make semi-fast temporary data structures, by hijacking the ListView control.
Ok, I take it that the Dim statement should include a control identifier (x) and then the "as something" should be the name of the control (minus the 1 that it automatically receives when placed on a form :) ).
Also, can the cursor be relocated on the screen (like Basic or QBasic's LOCATE statement) while in the console?
Thanks for your help
FMillion, the smiley was not supposed to be there, I think it should be a ).
As for positioning the cursor, yes you can. You need to use the SetConsoleCursorPosition API. But beware, it is not correctly defined the Win32API.
The reason the SetConsoleCursorPosition function fails is it is declared incorrectly in the API text viewer. It is defined like this:
Declare Function SetConsoleCursorPosition _
Lib "kernel32" (ByVal hConsoleOutput As Long, _
dwCursorPosition As COORD) As Long
The problem is, the 2nd argument "dwCursorPosition" must be passed ByVal, not ByRef. If you don't specify ByVal, ByRef is the default in Visual Basic... HOWEVER... VB will not let you pass a user-defined type ByVal.
This means you have to define the function like this:
Declare Function SetConsoleCursorPosition _
Lib "kernel32" (ByVal hConsoleOutput As Long, _
ByVal dwCursorPosition As Long) As Long
Now, you have to fit the X/Y values that used to be assigned with the COORD type into a Long type. You can do this by adding this function to your module:
Function cvtCoordToLng(wHi As Integer, wLo As Integer) As Long
cvtCoordToLng = (wHi * &H10000) Or (wLo And &HFFFF&)
End Function
Then when you call the SetConsoleCursorPosition API, you want to do it like this:
Dim Row As Integer
Dim Col As Integer
Dim rVal As Long
'SET Row and Col to the proper values here
rVal = SetConsoleCursorPosition(hStdOut, cvtCoordToLng(Row, Col))
It did it again, the smiley should be )
Oh yeah. When defining the Winsock control in a formless app, use:
Then, the Winsock control's events will *magically* appear in the event list. Coolness.Code:Dim WithEvents MyNet as Winsock
This is not exactly related to this post, but it is related to the work i'm doing:
I tried creating controls in runtime by Dim-ing them.
For example, I typed
Dim tmrDelay As Timer
However, I was then unable to set the properties for this time object. I was given Error 91: Object variable or With block variable not set.
I'm sure I'm missing something, could someone please help me out?
Thank you VERY MUCH for the console mode help!!
hi, that's what I need, but actually I'm not sure what to do with it. I have my own project, I start it from a command line and want to put some text in the same window. What about your sample? How should I use it?
FMillion - use:
This is because Timer is an object, and as such must be created with New. The WithEvents just tells it where to send the events (the local class module).Code:Dim WithEvents Timer1 As New Timer