?
Solved

VB6: Command prompt without Close button (or X) started by VB6

Posted on 2006-04-07
14
Medium Priority
?
2,378 Views
Last Modified: 2016-08-24
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

0
Comment
Question by:HStrix
14 Comments
 
LVL 28

Accepted Solution

by:
vinnyd79 earned 2000 total points
ID: 16399651
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
 
LVL 28

Expert Comment

by:vinnyd79
ID: 16399680
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
 

Author Comment

by:HStrix
ID: 16399834
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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:HStrix
ID: 16399894
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
 

Author Comment

by:HStrix
ID: 16399934
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
 
LVL 3

Expert Comment

by:rafunk
ID: 16400114
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
 

Author Comment

by:HStrix
ID: 16400655
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
 
LVL 28

Expert Comment

by:vinnyd79
ID: 16400790
What OS are you running?
0
 
LVL 28

Expert Comment

by:vinnyd79
ID: 16400887
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
 

Author Comment

by:HStrix
ID: 16401029
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
 
LVL 28

Expert Comment

by:vinnyd79
ID: 16401803
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
 

Author Comment

by:HStrix
ID: 16401974
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
 

Author Comment

by:HStrix
ID: 16514768
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
 

Expert Comment

by:Hamzah Wareh
ID: 41769093
What should I save the code???
Should I save as .bat or .vbs
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

864 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question