Solved

Console application with Visual Basic

Posted on 2000-05-03
5
1,070 Views
Last Modified: 2013-12-25
How do I write a Visual Basic console application for WindowsNT 4.0 similar to the one I write using C?

My requirement is that the i/o should be within the same console which kicks off the exe.  No new console should be created.

Solution should be compatible with VB 5.0/6.0 versions

Thanks in advance.
0
Comment
Question by:sgovinda
  • 2
  • 2
5 Comments
 
LVL 9

Expert Comment

by:cymbolic
ID: 2775252
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&
Private Const FOREGROUND_RED = &H4
Private Const FOREGROUND_GREEN = &H2
Private Const FOREGROUND_BLUE = &H1
Private Const FOREGROUND_INTENSITY = &H8
Private Const BACKGROUND_RED = &H40
Private Const BACKGROUND_GREEN = &H20
Private Const BACKGROUND_BLUE = &H10
Private Const BACKGROUND_INTENSITY = &H80
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
Private Const ENABLE_PROCESSED_OUTPUT = &H1
Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2
Private hConsoleIn As Long
Private hConsoleOut As Long
Private hConsoleErr As Long
Private Function CGet() As String
Dim sUserInput As String * 256
Call ReadConsole(hConsoleIn, sUserInput, Len(sUserInput), vbNull, vbNull)
CGet = Left$(sUserInput, InStr(sUserInput, Chr$(0)) - 3)
End Function
Private Sub CPrint(Cout As String)
WriteConsole hConsoleOut, Cout, Len(Cout), vbNull, vbNull
End Sub
Sub Main()
Dim UserIn As String
AllocConsole
SetConsoleTitle "VB DOS Console"
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_GREEN
CPrint "VB DOS" & vbCrLf
SetConsoleTextAttribute hConsoleOut, FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE Or FOREGROUND_INTENSITY
CPrint "Input name: "
UserIn = CGet()
If Not UserIn = "" Then
CPrint "Hi, " & UserIn & "!!" & vbCrLf
Else
CPrint "Hi" & vbCrLf
End If
CPrint "Type Exit to Quit" + vbCrLf
While UCase$(UserIn) <> "EXIT"
 UserIn = CGet()
 CPrint UserIn + vbCrLf
Wend
FreeConsole
End Sub
0
 
LVL 1

Author Comment

by:sgovinda
ID: 2776323
cymbolic,

I already knew about the solution you have given.

What I am looking for is - When I kick off the exe from a console command line, I should continue to operate within the same console (a new console should not be allocated).  It should behave in a way similar to an exe built using C.
0
 
LVL 43

Accepted Solution

by:
TimCottee earned 100 total points
ID: 2776606
There is a solution to this, though it does involve a slight hack of the program. The following is the code of an application which when pasted into a module and compiled, will take your "console application" executable and convert it into a standard executable which will run in the original console window.

Paste this code into a module, save as MakeConsole.Bas or whatever and compile to MakeVBCon.EXE.

Then compile your console app without using the AllocConsole Api call. Run MakeVBCon MyApp.EXE. Then you can run MyApp.Exe in a console window without generating a new one.


' ------------------------------------------------------
' MakeConsole.BAS -- Copyright (c) Slightly Tilted Software
' By: L.J. Johnson       Date: 11-30-1997
' Comments:    Contains MAIN(), plus the function
'              which take a standard VB 5.0 EXE (  or VB 6.0 ! )
'              and change it to a 32-bit console app
' ------------------------------------------------------
Option Explicit
Option Base 1
DefLng A-Z

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 Main()
   Dim strCmd              As String
   Dim strMsg              As String
   Dim strRtn              As String
       
   strCmd = Command$
       
   If Trim$(strCmd) = "" Then
      strMsg = "You must enter the name of a VB 5.0 standard executable file."
      MsgBox strMsg, vbExclamation, constMsgTitle
   Else
      If InStr(1, strCmd, ".", vbTextCompare) = 0 Then
         strCmd = strCmd & ".EXE"
      End If
         
      If Exists(strCmd) = True Then
         strRtn = SetConsoleApp(strCmd)
         MsgBox strRtn, vbInformation, constMsgTitle
      Else
         strMsg = "The file, " & Trim$(strCmd) & ", 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

Hope this helps, get back to me if you have any problems.
0
 
LVL 1

Author Comment

by:sgovinda
ID: 2777141
TimCottee,

The solution is terrific, eventhough it requires a hack to get it done.

Thanks!
0
 
LVL 43

Expert Comment

by:TimCottee
ID: 2777150
You are welcome.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Excel Vlookup to move data back to source. 4 84
Sending a email via excel using vba 6 72
VB6 - Convert HH:MM into Decimal 8 53
MS Access 03, TransferText, decimal places 8 47
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
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…

861 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

Need Help in Real-Time?

Connect with top rated Experts

25 Experts available now in Live!

Get 1:1 Help Now