• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 209
  • Last Modified:

Outputting to a COMMAND.EXE dosprompt

Hi,

I am making a command line utility, and need to be able to output information back to the user in at the prompt.

I have posted a similar question earlier, and got some answers that, when you run a VB prog, creates a DOSBOX, and you can then output to that.

This is not what i was looking for.  I need to be able to run a program from a c:\ prompt, and then output information back to the prompt. (ie. telling the user the command line options that are available, error messages etc.)
0
FlyveHest
Asked:
FlyveHest
  • 5
  • 3
1 Solution
 
mcriderCommented:
Here is an example of printing information to the console window.

Add the following to a new project.  Remove the Form1 from the new project and set the Startup Object to be Sub Main and compile this program into an EXE called MAKEVBCON.EXE:

' ------------------------------------------------------
' 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






'===============================================================================================================================================================
'===============================================================================================================================================================
Now, In a NEW PROJECT, Add the following to a MODULE:

Declare Function GetStdHandle Lib "kernel32" _
    (ByVal nStdHandle As Long) As Long
Declare Function ReadFile Lib "kernel32" _
    (ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    lpOverlapped As Any) As Long
Declare Function WriteFile Lib "kernel32" _
    (ByVal hFile As Long, _
    ByVal lpBuffer As String, _
    ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, _
    lpOverlapped As Any) As Long
Declare Function SetFilePointer Lib "kernel32" _
   (ByVal hFile As Long, _
   ByVal lDistanceToMove As Long, _
   lpDistanceToMoveHigh As Long, _
   ByVal dwMoveMethod As Long) As Long
Declare Function SetEndOfFile Lib "kernel32" _
   (ByVal hFile As Long) As Long

Public Const STD_INPUT_HANDLE = -10&
Public Const STD_OUTPUT_HANDLE = -11&

Sub Send(s As String)
'======================
' Send output to STDOUT
'======================
Dim lBytesWritten As Long

s = s & vbCrLf
WriteFile hStdOut, s, Len(s), lBytesWritten, ByVal 0&
End Sub

Sub SendB(s As String)
'============================================
' Send output to STDOUT without vbCrLf.
' Use when sending binary data. For example,
' images sent with "Content-type image/jpeg".
'============================================
Dim lBytesWritten As Long

WriteFile hStdOut, s, Len(s), lBytesWritten, ByVal 0&
End Sub

Sub Main()
Dim i As Integer
Dim j As Integer
Dim InputRecord As String

hStdIn = GetStdHandle(STD_INPUT_HANDLE)
hStdOut = GetStdHandle(STD_OUTPUT_HANDLE)

Send "This will appear in the console window"
End
End Sub



'===============================================================================================================================================================
'===============================================================================================================================================================

Now compile this new project into an EXE called MYPROG.EXE and terminate VB.

In a DOS console window, run the following command:

   MAKEVBCON MYPROG.EXE

This will convert the MYPROG.EXE into a console app.

Now you can run MYPROG.EXE and watch the console window....


Cheers!

0
 
mcriderCommented:
I forgot to tell you, in the program above called MYPROG.EXE before you compile it into an EXE, set the Startup Object to SUB MAIN


Cheers!

0
 
FlyveHestAuthor Commented:
Sorry, this doesnt work.
I can compile the MakeCon program, and after that compile and convert the test program (MakeCon reports that is has been converted into a console app)

BUT, when i run the converted program, a blank line is printed in the console, and nothing more happens.  Even if i try and add more output lines, i would suspect more blank lines, but only one is printed)

I am running VB5 under WinNT/SP6a .. I dont know if this setup require another setup?
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
mcriderCommented:
In the DECLARATIONS SECTION of the 2nd program, add the following code:

Public hStdIn  As Long   ' handle of Standard Input
Public hStdOut As Long   ' handle of Standard Output


Don't forget to make the startup object main...


Cheers!
0
 
FlyveHestAuthor Commented:
Yes, that did the trick, thanks a lot.

If you dont mind me asking, I can see theres a ReadFile inthere also, does this mean you can accept input from StdIn also?  (and, how?)
0
 
mcriderCommented:
Yes as a matter of fact you can...
Add the following code to the module:

   Function GetInput(Optional BufferSize As Long) As String
       Dim sBuf As String
       Dim BytesRead As Long
       Dim Retcode As Long
       Dim sBufSize As Long
       sBufSize = IIf(BufferSize = 0, 2048, BufferSize)
       sBuf = String(sBufSize, Chr$(0))
       Retcode = ReadFile(hStdIn, ByVal sBuf, sBufSize, BytesRead, ByVal 0&)
       GetInput = Left$(sBuf, BytesRead - 2)
   End Function


Then you can do this after the hStdIn and hStdOut are set in Main():

    Dim MyString As String
    MyString=GetInput()



If your're feeling generous, you can open another question with the title "FOR MCRIDER ONLY" and assign a couple of points to it... That way I'll get credit for this extra information...


Cheers!
0
 
FlyveHestAuthor Commented:
Will do :-)
0
 
mcriderCommented:
Thanks!
0

Featured Post

Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now