×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Console applications
3

Console applications

Console applications

(OP)
Can anyone tell me how to write a console application using VB6?

RE: Console applications

I have recently written a very basic application using a console. I would be happy to send you a copy of the code.

RE: Console applications

Mike, that's too easy. Good research. And thanks for providing an answer to a pesky problem (the API I sent was NT specific).

RE: Console applications

Module :


Option Explicit

'This app uses 1 console only, but is easily to rebuild to multiple consoles.
Global hConsOutput As Long
Global hConsInput As Long

Public Const ENABLE_ECHO_INPUT = &H4
Public Const ENABLE_LINE_INPUT = &H2
Public Const STD_INPUT_HANDLE = -10&
Public Const STD_OUTPUT_HANDLE = -11&

Public Type COORD

X As Integer
Y As Integer

End Type

Public Type SMALL_RECT

Left As Integer
Top As Integer
Right As Integer
Bottom As Integer

End Type

Public Type CONSOLE_SCREEN_BUFFER_INFO

dwSize As COORD
dwCursorPosition As COORD
wAttributes As Integer
srWindow As SMALL_RECT
dwMaximumWindowSize As COORD

End Type

Public Declare Function AllocConsole Lib "kernel32" () As Long
Public Declare Function FreeConsole Lib "kernel32" () As Long
Public Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Public Declare Function ReadFileNULL Lib "kernel32" Alias "ReadFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
Public Declare Function SetConsoleMode Lib "kernel32" (ByVal hConsoleHandle As Long, ByVal dwMode As Long) As Long
Public Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
Public Declare Function SetConsoleCursorPosition Lib "kernel32" (ByVal hConsoleOutput As Long, dwCursorPosition As COORD) As Long
Public Declare Function GetConsoleScreenBufferInfo Lib "kernel32" (ByVal hConsoleOutput As Long, lpConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO) As Long

Sub CreateDosConsole()

On Error Resume Next

Dim a As Long
Dim T As String

If hConsOutput Or hConsInput Then Beep: Exit Sub

'Create new console.
AllocConsole

'We need handles for in and output
hConsInput = GetStdHandle(STD_INPUT_HANDLE)
hConsOutput = GetStdHandle(STD_OUTPUT_HANDLE)

'Set some attributes.
SetConsoleMode hConsInput, ENABLE_ECHO_INPUT

StdOut vbCrLf
StdOut "Enter filename (with full path and extension) or 'EXIT' to close.." & vbCrLf
StdOut vbCrLf

Do

a = 0
StdOut CurDir$ & ">"

'Retrieve
T = InputCons()

'You could use T$ to execute any (DOS)app.
Select Case UCase$(T)
Case "EXIT": Exit Do
Case ""
Case Else

'You might extend Shell to use the search path.
a = Shell(T, vbNormalFocus)
If a Then

'StdOut a & vbCrLf
StdOut vbCrLf

Else

StdOut "Bad command or filename " & Chr$(34) & T & Chr$(34) & " Type EXIT to close..." & vbCrLf & vbCrLf

End If

End Select

Loop

'This will close the console..
FreeConsole

hConsOutput = 0
hConsInput = 0

End Sub

Function CSRLIN() As Long

Dim lpConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO

GetConsoleScreenBufferInfo hConsOutput, lpConsoleScreenBufferInfo

CSRLIN = lpConsoleScreenBufferInfo.dwCursorPosition.Y

End Function

Function CSRPOS() As Long

Dim lpConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO

GetConsoleScreenBufferInfo hConsOutput, lpConsoleScreenBufferInfo

CSRPOS = lpConsoleScreenBufferInfo.dwCursorPosition.X

End Function

Function InputCons() As String

Dim T As String
Dim B As String

Do

T = ReadFileKeyBuffer()

If T > "" Then

' Debug.Print Asc(T)

Select Case Asc(T)
Case 10
Case vbKeyBack: If B > "" Then B = Left$(B, Len(B) - 1)
Case vbKeyReturn: Exit Do
Case Else: B = B & T
End Select

End If

Loop

InputCons = B

End Function

Sub Locate(ByVal Row As Long, ByVal Column As Long)

Dim dwCursorPosition As COORD
dwCursorPosition.X = Row
dwCursorPosition.Y = Column

SetConsoleCursorPosition hConsOutput, dwCursorPosition

End Sub

Function ReadFileKeyBuffer() As String

Dim T As Byte
Dim L As Long

ReadFileNULL hConsInput, T, Len(T), L, ByVal 0&

If L Then ReadFileKeyBuffer = Chr$(T)

End Function

Function RunDOSApp(ByVal FileName As String) As Long

On Error Resume Next

Dim a As Long
Dim hOut As Long

FileName = Trim$(FileName)
If FileName = "" Then Exit Function

AllocConsole

hOut = GetStdHandle(STD_OUTPUT_HANDLE)

RunDOSApp = Shell(FileName, 5)

FreeConsole

End Function

Sub StdOut(ByVal Text As String)

Dim a As Long
Dim L As Long

If Len(Text) < 1 Then Exit Sub

'Convert unicode to ansi.
ReDim ByteBuffer(0 To Len(Text)) As Byte

For a = 1 To Len(Text)
ByteBuffer(a) = Asc(Mid$(Text, a, 1))
Next a

WriteConsole hConsOutput, ByVal VarPtr(ByteBuffer(1)), UBound(ByteBuffer), L, ByVal 0&

End Sub

Form with two buttons :

Private Sub Command1_Click()

CreateDosConsole

End Sub

Private Sub Command2_Click()

RunDOSApp "test.bat"

End Sub

Eric De Decker
vbg.be@vbgroup.nl
Visual Basic Center

RE: Console applications

Great tip, Eric! It's a bit buggy but it will work.
Hey Mike! Guess who just won the WriteConsole contest!

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login


Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close