Console applications 3

There's an API that Alt255 pointed out to me a little while ago - and now I lost it :-(<br>
<br>
Alt255?<br>
<br>
Mike<br>
<p>Mike Lacey<br><a href=mailto:Mike_Lacey@Cargill.Com>Mike_Lacey@Cargill.Com</a><br><a href=http:// Cargill's Corporate Web Site</a><br>

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

Came across this today - interesting site as well<br>
<br>
<A HREF=" TARGET="_new"><br>
Mike<br>
<p>Mike Lacey<br><a href=mailto:Mike_Lacey@Cargill.Com>Mike_Lacey@Cargill.Com</a><br><a href= Cargill's Corporate Web Site</a><br>

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

Module :<br>
<br>
<br>
Option Explicit<br>
<br>
'This app uses 1 console only, but is easily to rebuild to multiple consoles.<br>
Global hConsOutput As Long<br>
Global hConsInput As Long<br>
<br>
Public Const ENABLE_ECHO_INPUT = &H4<br>
Public Const ENABLE_LINE_INPUT = &H2<br>
Public Const STD_INPUT_HANDLE = -10&<br>
Public Const STD_OUTPUT_HANDLE = -11&<br>
<br>
Public Type COORD<br>
<br>
X As Integer<br>
Y As Integer<br>
<br>
End Type<br>
<br>
Public Type SMALL_RECT<br>
<br>
Left As Integer<br>
Top As Integer<br>
Right As Integer<br>
Bottom As Integer<br>
<br>
End Type<br>
<br>
Public Type CONSOLE_SCREEN_BUFFER_INFO<br>
<br>
dwSize As COORD<br>
dwCursorPosition As COORD<br>
wAttributes As Integer<br>
srWindow As SMALL_RECT<br>
dwMaximumWindowSize As COORD<br>
<br>
End Type<br>
<br>
Public Declare Function AllocConsole Lib &quot;kernel32&quot; () As Long<br>
Public Declare Function FreeConsole Lib &quot;kernel32&quot; () As Long<br>
Public Declare Function GetStdHandle Lib &quot;kernel32&quot; (ByVal nStdHandle As Long) As Long<br>
Public Declare Function ReadFileNULL Lib &quot;kernel32&quot; Alias &quot;ReadFile&quot; (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long<br>
Public Declare Function SetConsoleMode Lib &quot;kernel32&quot; (ByVal hConsoleHandle As Long, ByVal dwMode As Long) As Long<br>
Public Declare Function WriteConsole Lib &quot;kernel32&quot; Alias &quot;WriteConsoleA&quot; (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long<br>
Public Declare Function SetConsoleCursorPosition Lib &quot;kernel32&quot; (ByVal hConsoleOutput As Long, dwCursorPosition As COORD) As Long<br>
Public Declare Function GetConsoleScreenBufferInfo Lib &quot;kernel32&quot; (ByVal hConsoleOutput As Long, lpConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO) As Long<br>
<br>
Sub CreateDosConsole()<br>
<br>
On Error Resume Next<br>
<br>
Dim a As Long<br>
Dim T As String<br>
<br>
If hConsOutput Or hConsInput Then Beep: Exit Sub<br>
<br>
'Create new console.<br>
AllocConsole<br>
<br>
'We need handles for in and output<br>
hConsInput = GetStdHandle(STD_INPUT_HANDLE)<br>
hConsOutput = GetStdHandle(STD_OUTPUT_HANDLE)<br>
<br>
'Set some attributes.<br>
SetConsoleMode hConsInput, ENABLE_ECHO_INPUT<br>
<br>
StdOut vbCrLf<br>
StdOut &quot;Enter filename (with full path and extension) or 'EXIT' to close..&quot; & vbCrLf<br>
StdOut vbCrLf<br>
<br>
Do<br>
<br>
a = 0<br>
StdOut CurDir$ & &quot;&gt;&quot;<br>
<br>
'Retrieve<br>
T = InputCons()<br>
<br>
'You could use T$ to execute any (DOS)app.<br>
Select Case UCase$(T)<br>
Case &quot;EXIT&quot;: Exit Do<br>
Case &quot;&quot;<br>
Case Else<br>
<br>
'You might extend Shell to use the search path.<br>
a = Shell(T, vbNormalFocus)<br>
If a Then<br>
<br>
'StdOut a & vbCrLf<br>
StdOut vbCrLf<br>
<br>
Else<br>
<br>
StdOut &quot;Bad command or filename &quot; & Chr$(34) & T & Chr$(34) & &quot; Type EXIT to close...&quot; & vbCrLf & vbCrLf<br>
<br>
End If<br>
<br>
End Select<br>
<br>
Loop<br>
<br>
'This will close the console..<br>
FreeConsole<br>
<br>
hConsOutput = 0<br>
hConsInput = 0<br>
<br>
End Sub<br>
<br>
Function CSRLIN() As Long<br>
<br>
Dim lpConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO<br>
<br>
GetConsoleScreenBufferInfo hConsOutput, lpConsoleScreenBufferInfo<br>
<br>
CSRLIN = lpConsoleScreenBufferInfo.dwCursorPosition.Y<br>
<br>
End Function<br>
<br>
Function CSRPOS() As Long<br>
<br>
Dim lpConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO<br>
<br>
GetConsoleScreenBufferInfo hConsOutput, lpConsoleScreenBufferInfo<br>
<br>
CSRPOS = lpConsoleScreenBufferInfo.dwCursorPosition.X<br>
<br>
End Function<br>
<br>
Function InputCons() As String<br>
<br>
Dim T As String<br>
Dim B As String<br>
<br>
Do<br>
<br>
T = ReadFileKeyBuffer()<br>
<br>
If T &gt; &quot;&quot; Then<br>
<br>
' Debug.Print Asc(T)<br>
<br>
Select Case Asc(T)<br>
Case 10<br>
Case vbKeyBack: If B &gt; &quot;&quot; Then B = Left$(B, Len(B) - 1)<br>
Case vbKeyReturn: Exit Do<br>
Case Else: B = B & T<br>
End Select<br>
<br>
End If<br>
<br>
Loop<br>
<br>
InputCons = B<br>
<br>
End Function<br>
<br>
Sub Locate(ByVal Row As Long, ByVal Column As Long)<br>
<br>
Dim dwCursorPosition As COORD<br>
dwCursorPosition.X = Row<br>
dwCursorPosition.Y = Column<br>
<br>
SetConsoleCursorPosition hConsOutput, dwCursorPosition<br>
<br>
End Sub<br>
<br>
Function ReadFileKeyBuffer() As String<br>
<br>
Dim T As Byte<br>
Dim L As Long<br>
<br>
ReadFileNULL hConsInput, T, Len(T), L, ByVal 0&<br>
<br>
If L Then ReadFileKeyBuffer = Chr$(T)<br>
<br>
End Function<br>
<br>
Function RunDOSApp(ByVal FileName As String) As Long<br>
<br>
On Error Resume Next<br>
<br>
Dim a As Long<br>
Dim hOut As Long<br>
<br>
FileName = Trim$(FileName)<br>
If FileName = &quot;&quot; Then Exit Function<br>
<br>
AllocConsole<br>
<br>
hOut = GetStdHandle(STD_OUTPUT_HANDLE)<br>
<br>
RunDOSApp = Shell(FileName, 5)<br>
<br>
FreeConsole<br>
<br>
End Function<br>
<br>
Sub StdOut(ByVal Text As String)<br>
<br>
Dim a As Long<br>
Dim L As Long<br>
<br>
If Len(Text) &lt; 1 Then Exit Sub<br>
<br>
'Convert unicode to ansi.<br>
ReDim ByteBuffer(0 To Len(Text)) As Byte<br>
<br>
For a = 1 To Len(Text)<br>
ByteBuffer(a) = Asc(Mid$(Text, a, 1))<br>
Next a<br>
<br>
WriteConsole hConsOutput, ByVal VarPtr(ByteBuffer(1)), UBound(ByteBuffer), L, ByVal 0&<br>
<br>
End Sub<br>
<br>
Form with two buttons :<br>
<br>
Private Sub Command1_Click()<br>
<br>
CreateDosConsole<br>
<br>
End Sub<br>
<br>
Private Sub Command2_Click()<br>
<br>
RunDOSApp &quot;test.bat&quot;<br>
<br>
End Sub<br>
<p>Eric De Decker<br><a href=mailto:vbg.be@vbgroup.nl>vbg.be@vbgroup.nl</a><br><a href= Basic Center</a><br>

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

&lt;grin&gt; No surprises there. That's the trouble with the Dutch - they all work too hard and show the rest of us up!<br>
<br>
Nice one Eric.<br>
<br>
Mike<br>
<br>
<p>Mike Lacey<br><a href=mailto:Mike_Lacey@Cargill.Com>Mike_Lacey@Cargill.Com</a><br><a href= Cargill's Corporate Web Site</a><br>