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

HStrixAsked:
Who is Participating?
 
vinnyd79Commented:
here is a simple example that will find the command prompt window by it's window caption and disable the "x"


Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
            (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal _
                            wFlags As Long) As Long
Private Const MF_BYPOSITION = &H400


Private Sub Command1_Click()
Dim cmdHwnd As Long, SysMenu As Long, Res As Long
cmdHwnd = FindWindow(vbNullString, "C:\WINDOWS\system32\cmd.exe")
If cmdHwnd <> 0 Then
    SysMenu = GetSystemMenu(cmdHwnd, 0)
    Res = RemoveMenu(SysMenu, 6, MF_BYPOSITION)
    SetForegroundWindow cmdHwnd
End If
End Sub
0
 
vinnyd79Commented:
Im not sure what else your app does,but yuo could also run netstat without a batch file. Try pasting this onto a form with a command button:


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_INFORMATION, False, Shell(PathName, WindowStyle))
    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
0
 
HStrixAuthor Commented:
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.

0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

 
HStrixAuthor Commented:
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


0
 
HStrixAuthor Commented:
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?
0
 
rafunkCommented:
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
0
 
HStrixAuthor Commented:
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.
0
 
vinnyd79Commented:
What OS are you running?
0
 
vinnyd79Commented:
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_INFORMATION, 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
0
 
HStrixAuthor Commented:
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.
0
 
vinnyd79Commented:
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_INFORMATION, 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.


0
 
HStrixAuthor Commented:
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_HANDLE + STD_INPUT_HANDLE)
        hConsole = GetStdHandle(STD_OUTPUT_HANDLE)
        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
0
 
HStrixAuthor Commented:
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
0
 
Hamzah WarehCommented:
What should I save the code???
Should I save as .bat or .vbs
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.