HStrix
asked on
VB6: Command prompt without Close button (or X) started by VB6
Hello experts,
in Visual Basic (VB6) Program I'm running a command prompt.
---
' VB6 code part:
Private Declare Function WriteConsole Lib "kernel32" _
Alias "WriteConsoleA" _
(ByVal hConsoleOutput As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfCharsToWrite As Long, _
lpNumberOfCharsWritten As Long, _
lpReserved As Any) As Long
'
app_name = App.Path & "\" & "Console.bat"" " & "2"
txt = "Ready to run" & vbCrLf
WriteConsole hConsole, txt, Len(txt), num_written, vbNullString
' the next line executes an application asynchronously
Shell app_name
---
rem console.bat
@ECHO OFF
if "%1" == "2" goto netstat
:netstat
@ECHO ON
netstat
@ECHO OFF
goto eof
:eof
---
Everything is working, but if the command prompt is closed ,
the VB6 programs gets closed too.
Now I came up with the idea to ensure that the menu point Close in the system menu
of the displayed command prompt window is disabled (or clicks are ignored).
That also means that the X (cross the the upper right corner) cannot be used.
Is there a way to do this?
If anyone can help me,
please supply appropriate information.
Thank you for any help.
HStrix
in Visual Basic (VB6) Program I'm running a command prompt.
---
' VB6 code part:
Private Declare Function WriteConsole Lib "kernel32" _
Alias "WriteConsoleA" _
(ByVal hConsoleOutput As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfCharsToWrite As Long, _
lpNumberOfCharsWritten As Long, _
lpReserved As Any) As Long
'
app_name = App.Path & "\" & "Console.bat"" " & "2"
txt = "Ready to run" & vbCrLf
WriteConsole hConsole, txt, Len(txt), num_written, vbNullString
' the next line executes an application asynchronously
Shell app_name
---
rem console.bat
@ECHO OFF
if "%1" == "2" goto netstat
:netstat
@ECHO ON
netstat
@ECHO OFF
goto eof
:eof
---
Everything is working, but if the command prompt is closed ,
the VB6 programs gets closed too.
Now I came up with the idea to ensure that the menu point Close in the system menu
of the displayed command prompt window is disabled (or clicks are ignored).
That also means that the X (cross the the upper right corner) cannot be used.
Is there a way to do this?
If anyone can help me,
please supply appropriate information.
Thank you for any help.
HStrix
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks vinnyd79,
my application invokes also other functions, ping nbtstat, ..
That's why I created a command prompt window and transfered parameters to the bat-procedure.
my application invokes also other functions, ping nbtstat, ..
That's why I created a command prompt window and transfered parameters to the bat-procedure.
ASKER
Currently my process is as follows:
- select a function on the main window
- create a new mini-window (form) having a Start and a Stop button only
and minimize the main window
- after clicking Start the command prompt is issued accordingly to the selected function (parameter[s]->argument[s] )
- after clicking Stop, the command prompt is closed,
the mini-window is closed
and the main window is re-established
- select a function on the main window
- create a new mini-window (form) having a Start and a Stop button only
and minimize the main window
- after clicking Start the command prompt is issued accordingly to the selected function (parameter[s]->argument[s]
- after clicking Stop, the command prompt is closed,
the mini-window is closed
and the main window is re-established
ASKER
If I look at your first comment,
I don't understand how I can issue the bat-procedure
and then disable the X/Close button.
How can this be achieved by your second comment?
I don't understand how I can issue the bat-procedure
and then disable the X/Close button.
How can this be achieved by your second comment?
I think you'd better consider to turn your app from standard to real console app.
In fact, if you open a console window from a standard app and then close console window before closing main application, it will likely crash.
VB6 IDE natively doesn't provide you a way to compile a program for console subsystem, but if you look at the following article, you'll discover a way to accomplish that:
http://www.xaprb.com/blog/2005/10/14/how-to-create-a-vb6-console-program
HTH
Raf
In fact, if you open a console window from a standard app and then close console window before closing main application, it will likely crash.
VB6 IDE natively doesn't provide you a way to compile a program for console subsystem, but if you look at the following article, you'll discover a way to accomplish that:
http://www.xaprb.com/blog/2005/10/14/how-to-create-a-vb6-console-program
HTH
Raf
ASKER
Thanks rafunk,
my VB6 program cannot run as a console application.
The invocation of console functions (using a command prompt) is only one function
of a lots of other functions of a windows application.
my VB6 program cannot run as a console application.
The invocation of console functions (using a command prompt) is only one function
of a lots of other functions of a windows application.
What OS are you running?
You can use other functions without a bat file. Give this a try. Paste this onto a form with a Listbox. Then double click the command in the listbox.
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400
Private Function ShellWait(PathName, Optional WindowStyle As VbAppWinStyle = vbNormalFocus) As Double
Dim hProcess As Long, RetVal As Long
hProcess = OpenProcess(PROCESS_QUERY_ INFORMATIO N, False, Shell(PathName, WindowStyle))
Do
GetExitCodeProcess hProcess, RetVal
DoEvents: Sleep 100
Loop While RetVal = STILL_ACTIVE
End Function
Private Sub Form_Load()
List1.AddItem "netstat"
List1.AddItem "ping"
List1.AddItem "nbtstat"
List1.AddItem "set"
List1.AddItem "net start"
End Sub
Private Sub List1_DblClick()
Dim TmpFile As String, fData As String, Pm As String, ff As Integer
If Not List1.ListIndex = -1 Then
Pm = InputBox("Enter any parameters that might be needed", "Enter parameters is Any")
TmpFile = Environ("Temp") & "\cmds.tmp"
ShellWait Environ("ComSpec") & " /c " & List1.List(List1.ListIndex ) & " " & Trim$(Pm) & " > " & TmpFile, vbHide
ff = FreeFile
Open TmpFile For Input As #ff
fData = Input$(LOF(ff), ff)
Close #ff
MsgBox fData
Kill TmpFile
End If
End Sub
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400
Private Function ShellWait(PathName, Optional WindowStyle As VbAppWinStyle = vbNormalFocus) As Double
Dim hProcess As Long, RetVal As Long
hProcess = OpenProcess(PROCESS_QUERY_
Do
GetExitCodeProcess hProcess, RetVal
DoEvents: Sleep 100
Loop While RetVal = STILL_ACTIVE
End Function
Private Sub Form_Load()
List1.AddItem "netstat"
List1.AddItem "ping"
List1.AddItem "nbtstat"
List1.AddItem "set"
List1.AddItem "net start"
End Sub
Private Sub List1_DblClick()
Dim TmpFile As String, fData As String, Pm As String, ff As Integer
If Not List1.ListIndex = -1 Then
Pm = InputBox("Enter any parameters that might be needed", "Enter parameters is Any")
TmpFile = Environ("Temp") & "\cmds.tmp"
ShellWait Environ("ComSpec") & " /c " & List1.List(List1.ListIndex
ff = FreeFile
Open TmpFile For Input As #ff
fData = Input$(LOF(ff), ff)
Close #ff
MsgBox fData
Kill TmpFile
End If
End Sub
ASKER
I'm running NT4, W2K, WXP, W2003, W9X, all with VB6 SP6+.
WXP Profi/Home and W2003 are mostly used.
---
I see what you mean.
I could imagine that you comment meets my so-called mini-form.
What I want is that after having choosen one of the functions,
that the main windows gets minimized
and after finishing the console prompt window
the main window is visible in "normal" (vbNormal) mode again.
WXP Profi/Home and W2003 are mostly used.
---
I see what you mean.
I could imagine that you comment meets my so-called mini-form.
What I want is that after having choosen one of the functions,
that the main windows gets minimized
and after finishing the console prompt window
the main window is visible in "normal" (vbNormal) mode again.
Something like this?
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400
Private Function ShellWait(PathName, Optional WindowStyle As VbAppWinStyle = vbNormalFocus) As Double
Dim hProcess As Long, RetVal As Long
hProcess = OpenProcess(PROCESS_QUERY_ INFORMATIO N, False, Shell(PathName, WindowStyle))
Do
GetExitCodeProcess hProcess, RetVal
DoEvents: Sleep 100
Loop While RetVal = STILL_ACTIVE
End Function
Private Sub Form_Load()
List1.AddItem "netstat"
List1.AddItem "ping"
List1.AddItem "nbtstat"
List1.AddItem "set"
List1.AddItem "net start"
End Sub
Private Sub List1_DblClick()
Dim Pm As String
Me.WindowState = vbMinimized
If Not List1.ListIndex = -1 Then
Pm = InputBox("Enter any parameters that might be needed", "Enter parameters is Any")
ShellWait Environ("ComSpec") & " /k " & List1.List(List1.ListIndex ) & " " & Trim$(Pm), vbNormalFocus
End If
Me.WindowState = vbNormal
End Sub
This version will minimize the main form and leave the command window open with the data. When you close the command window the main form will be un-minimized.
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400
Private Function ShellWait(PathName, Optional WindowStyle As VbAppWinStyle = vbNormalFocus) As Double
Dim hProcess As Long, RetVal As Long
hProcess = OpenProcess(PROCESS_QUERY_
Do
GetExitCodeProcess hProcess, RetVal
DoEvents: Sleep 100
Loop While RetVal = STILL_ACTIVE
End Function
Private Sub Form_Load()
List1.AddItem "netstat"
List1.AddItem "ping"
List1.AddItem "nbtstat"
List1.AddItem "set"
List1.AddItem "net start"
End Sub
Private Sub List1_DblClick()
Dim Pm As String
Me.WindowState = vbMinimized
If Not List1.ListIndex = -1 Then
Pm = InputBox("Enter any parameters that might be needed", "Enter parameters is Any")
ShellWait Environ("ComSpec") & " /k " & List1.List(List1.ListIndex
End If
Me.WindowState = vbNormal
End Sub
This version will minimize the main form and leave the command window open with the data. When you close the command window the main form will be un-minimized.
ASKER
Thanks
FYI, my existing code is as follows
---
Private Type COORD
x As Integer
y As Integer
End Type
Private Type SMALL_RECT
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
Private Type CHAR_INFO
Char As Integer
Attributes As Integer
End Type
Private Declare Function AllocConsole Lib "kernel32" _
() As Long
Private Declare Function GetStdHandle Lib "kernel32" _
(ByVal nStdHandle As Long) As Long
Private Declare Function ReadConsoleOutput Lib "kernel32" _
Alias "ReadConsoleOutputA" _
(ByVal hConsoleOutput As Long, _
lpBuffer As CHAR_INFO, _
dwBufferSize As COORD, _
dwBufferCoord As COORD, _
lpReadRegion As SMALL_RECT) As Long
Private Declare Function WriteConsoleOutput Lib "kernel32" _
Alias "WriteConsoleOutputA" _
(ByVal hConsoleOutput As Long, _
lpBuffer As CHAR_INFO, _
dwBufferSize As COORD, _
dwBufferCoord As COORD, _
lpWriteRegion As SMALL_RECT) As Long
Private Declare Function ReadConsole Lib "kernel32" _
Alias "ReadConsoleA" _
(ByVal hConsoleInput As Long, _
lpBuffer As Any, _
ByVal nNumberOfCharsToRead As Long, _
lpNumberOfCharsRead As Long, _
lpReserved As Any) As Long
Private Declare Function WriteConsole Lib "kernel32" _
Alias "WriteConsoleA" _
(ByVal hConsoleOutput As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfCharsToWrite As Long, _
lpNumberOfCharsWritten As Long, _
lpReserved As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function FreeConsole Lib "kernel32" _
() As Long
Private Const STD_ERROR_HANDLE = -12&
Private Const STD_OUTPUT_HANDLE = -11&
Private Const STD_INPUT_HANDLE = -10&
Private hConsole As Long
Public actFunction As Integer
' Definition for "Always on top":
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Public Sub Command1_Click()
Dim app_name As String
Dim txt As String
Dim num_written As Long
Dim num_read As Long
Call Load_Form
app_name = App.Path
If Right$(app_name, 1) <> "\" Then app_name = app_name & "\"
If (actFunction = 3) Then
app_name = """" & app_name & "Console.bat"" " & actFunction & " " & myForm.Text2.Text
ElseIf (actFunction = 4) Then
app_name = """" & app_name & "Console.bat"" " & actFunction & " " & myForm.Text5.Text
Else
app_name = """" & app_name & "Console.bat"" " & actFunction
End If
txt = "Ready to run" & vbCrLf
Command1.Enabled = False
WriteConsole hConsole, txt, Len(txt), num_written, vbNullString
' the next line executes an application asynchronously
Shell app_name
' where is the proper place for reading?
'ReadConsole hConsole, txt, Len(txt), num_read, vbNullString
Command2.Enabled = True
End Sub
Public Sub Command2_Click()
myForm.WindowState = vbNormal
myForm.Text5.Text = ""
Unload Me
End Sub
Public Sub Load_Form()
Dim txt As String
Dim num_written As Long
If AllocConsole() Then
' adding of STD_INPUT_HANDLE prevents execution of WriteConsole!
'hConsole = GetStdHandle(STD_OUTPUT_HA NDLE + STD_INPUT_HANDLE)
hConsole = GetStdHandle(STD_OUTPUT_HA NDLE)
If hConsole = 0 Then MsgBox "Couldn't allocate STDOUT"
' Present a warning.
txt = "************************* ********** ***" & vbCrLf & _
"* Warning: Do not close this window! *" & vbCrLf & _
"* Press the button 'Stop' instead. *" & vbCrLf & _
"************************* ********** ***" & vbCrLf
WriteConsole hConsole, txt, Len(txt), num_written, vbNullString
' Make this form visible and on-top.
'Me.Show
'Me.Move Left, Top
Me.SetFocus
Else
MsgBox "The console couldn't be allocated." & vbCr _
, , " Information --- Network Environment"
End If
End Sub
Private Sub Form_Load()
Call AlwaysOnTop
Command1.Enabled = True
Command2.Enabled = False
' set proper caption in form:
If (actFunction = 1) Then
Me.Caption = "nbtstat -n"
ElseIf (actFunction = 2) Then
Me.Caption = "netstat"
ElseIf (actFunction = 3) Then
Me.Caption = "tracert " & myForm.Text2.Text
ElseIf (actFunction = 4) Then
myForm.Text5.Text = "www.mywebsite.de"
Me.Caption = "ping " & myForm.Text5.Text
End If
End Sub
Public Sub Form_Unload(Cancel As Integer)
CloseHandle hConsole
FreeConsole
End Sub
Private Sub AlwaysOnTop()
Dim rc As Long
rc = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
End Sub
FYI, my existing code is as follows
---
Private Type COORD
x As Integer
y As Integer
End Type
Private Type SMALL_RECT
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
Private Type CHAR_INFO
Char As Integer
Attributes As Integer
End Type
Private Declare Function AllocConsole Lib "kernel32" _
() As Long
Private Declare Function GetStdHandle Lib "kernel32" _
(ByVal nStdHandle As Long) As Long
Private Declare Function ReadConsoleOutput Lib "kernel32" _
Alias "ReadConsoleOutputA" _
(ByVal hConsoleOutput As Long, _
lpBuffer As CHAR_INFO, _
dwBufferSize As COORD, _
dwBufferCoord As COORD, _
lpReadRegion As SMALL_RECT) As Long
Private Declare Function WriteConsoleOutput Lib "kernel32" _
Alias "WriteConsoleOutputA" _
(ByVal hConsoleOutput As Long, _
lpBuffer As CHAR_INFO, _
dwBufferSize As COORD, _
dwBufferCoord As COORD, _
lpWriteRegion As SMALL_RECT) As Long
Private Declare Function ReadConsole Lib "kernel32" _
Alias "ReadConsoleA" _
(ByVal hConsoleInput As Long, _
lpBuffer As Any, _
ByVal nNumberOfCharsToRead As Long, _
lpNumberOfCharsRead As Long, _
lpReserved As Any) As Long
Private Declare Function WriteConsole Lib "kernel32" _
Alias "WriteConsoleA" _
(ByVal hConsoleOutput As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfCharsToWrite As Long, _
lpNumberOfCharsWritten As Long, _
lpReserved As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function FreeConsole Lib "kernel32" _
() As Long
Private Const STD_ERROR_HANDLE = -12&
Private Const STD_OUTPUT_HANDLE = -11&
Private Const STD_INPUT_HANDLE = -10&
Private hConsole As Long
Public actFunction As Integer
' Definition for "Always on top":
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Public Sub Command1_Click()
Dim app_name As String
Dim txt As String
Dim num_written As Long
Dim num_read As Long
Call Load_Form
app_name = App.Path
If Right$(app_name, 1) <> "\" Then app_name = app_name & "\"
If (actFunction = 3) Then
app_name = """" & app_name & "Console.bat"" " & actFunction & " " & myForm.Text2.Text
ElseIf (actFunction = 4) Then
app_name = """" & app_name & "Console.bat"" " & actFunction & " " & myForm.Text5.Text
Else
app_name = """" & app_name & "Console.bat"" " & actFunction
End If
txt = "Ready to run" & vbCrLf
Command1.Enabled = False
WriteConsole hConsole, txt, Len(txt), num_written, vbNullString
' the next line executes an application asynchronously
Shell app_name
' where is the proper place for reading?
'ReadConsole hConsole, txt, Len(txt), num_read, vbNullString
Command2.Enabled = True
End Sub
Public Sub Command2_Click()
myForm.WindowState = vbNormal
myForm.Text5.Text = ""
Unload Me
End Sub
Public Sub Load_Form()
Dim txt As String
Dim num_written As Long
If AllocConsole() Then
' adding of STD_INPUT_HANDLE prevents execution of WriteConsole!
'hConsole = GetStdHandle(STD_OUTPUT_HA
hConsole = GetStdHandle(STD_OUTPUT_HA
If hConsole = 0 Then MsgBox "Couldn't allocate STDOUT"
' Present a warning.
txt = "*************************
"* Warning: Do not close this window! *" & vbCrLf & _
"* Press the button 'Stop' instead. *" & vbCrLf & _
"*************************
WriteConsole hConsole, txt, Len(txt), num_written, vbNullString
' Make this form visible and on-top.
'Me.Show
'Me.Move Left, Top
Me.SetFocus
Else
MsgBox "The console couldn't be allocated." & vbCr _
, , " Information --- Network Environment"
End If
End Sub
Private Sub Form_Load()
Call AlwaysOnTop
Command1.Enabled = True
Command2.Enabled = False
' set proper caption in form:
If (actFunction = 1) Then
Me.Caption = "nbtstat -n"
ElseIf (actFunction = 2) Then
Me.Caption = "netstat"
ElseIf (actFunction = 3) Then
Me.Caption = "tracert " & myForm.Text2.Text
ElseIf (actFunction = 4) Then
myForm.Text5.Text = "www.mywebsite.de"
Me.Caption = "ping " & myForm.Text5.Text
End If
End Sub
Public Sub Form_Unload(Cancel As Integer)
CloseHandle hConsole
FreeConsole
End Sub
Private Sub AlwaysOnTop()
Dim rc As Long
rc = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
End Sub
ASKER
Thank you vinnyd79!
Sorry for the delay, but I needed to make several checks.
And I came to the conclusion,
that your first comment meets my expectations.
I also tried to incorporate your other code,
but I was not able to make this working as I wanted to have it.
Thank you again.
HStrix
Sorry for the delay, but I needed to make several checks.
And I came to the conclusion,
that your first comment meets my expectations.
I also tried to incorporate your other code,
but I was not able to make this working as I wanted to have it.
Thank you again.
HStrix
What should I save the code???
Should I save as .bat or .vbs
Should I save as .bat or .vbs
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400
Private Function ShellWait(PathName, Optional WindowStyle As VbAppWinStyle = vbNormalFocus) As Double
Dim hProcess As Long, RetVal As Long
hProcess = OpenProcess(PROCESS_QUERY_
Do
GetExitCodeProcess hProcess, RetVal
DoEvents: Sleep 100
Loop While RetVal = STILL_ACTIVE
End Function
Private Sub Command1_Click()
Dim TmpFile As String, fData As String, ff As Integer
TmpFile = Environ("Temp") & "\netstat.tmp"
ShellWait Environ("ComSpec") & " /c netstat > " & TmpFile, vbHide
ff = FreeFile
Open TmpFile For Input As #ff
fData = Input$(LOF(ff), ff)
Close #ff
MsgBox fData
Kill TmpFile
End Sub