Работа с консолью из VB6
Формулировка задачи:
Вот модуль класса, который я смонтировал,
черпая инфу из самых разнообразных источников...
который запускает консоль и даёт возможность вставлять туда свой текст...
теперь вопросы...
Листинг программы
- Sub main()
- Dim cons As New Console
- ' ConsoleWriteLine "Привет пиплы :)"
- cons.ConsoleWriteLine "Echo on"
- cons.ConsoleWriteLine "regsvr32 dllERR.dll"
- Debug.Print cons.ConsoleReadLine
- End Sub
- Как заставить такую консоль реально выполнять комманды ?
- почему, не функционирует ReadLine ?.. собственно из за нее и делаю...
- как настроить параметр запуск в скрытом режиме... ?
- можно ли какнибудь подменить используемые хендлы, на Хэндл
Shell("cmd.exe")
Листинг программы
- Option Explicit
- '
- '© FelixMacintosh 2014
- 'Работа с консолью с возможностью ввода/вывода русских символов
- '
- Private Const FOREGROUND_BLUE = &H1
- Private Const FOREGROUND_GREEN = &H2
- Private Const FOREGROUND_RED = &H4
- Private Const BACKGROUND_BLUE = &H10
- Private Const BACKGROUND_GREEN = &H20
- Private Const BACKGROUND_RED = &H40
- Private Const BACKGROUND_INTENSITY = &H80&
- Private Const BACKGROUND_SEARCH = &H20&
- Private Const FOREGROUND_INTENSITY = &H8&
- Private Const FOREGROUND_SEARCH = (&H10&)
- 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 Const STD_OUTPUT_HANDLE = -11&
- Private Const STD_INPUT_HANDLE = -10&
- Private Const STD_ERROR_HANDLE = -12&
- Private Const INVALID_HANDLE_VALUE = -1&
- Private Declare Function AllocConsole Lib "kernel32" () As Long
- Private Declare Function FreeConsole Lib "kernel32" () As Long
- Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
- Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
- Private 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
- 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 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 CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
- Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
- Private hConsoleOut As Long, hConsoleIn As Long, hConsoleErr As Long
- Private Sub Class_Initialize()
- If AllocConsole() Then
- hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
- If hConsoleOut = INVALID_HANDLE_VALUE Then MsgBox "Не удается получить STDOUT"
- hConsoleIn = GetStdHandle(STD_INPUT_HANDLE)
- If hConsoleOut = INVALID_HANDLE_VALUE Then MsgBox "Не удается получить STDIN"
- Else
- MsgBox "Невозможно запустить вторую копию консоли"
- End If
- 'Установить заголовок окна консоли
- SetConsoleTitle App.EXEName & "Copyright (c) FelixMacintosh 2014"
- 'Задать синий фона текста в консоли с ярко-желтыми символами
- SetConsoleTextAttribute hConsoleOut, FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY _
- Or BACKGROUND_BLUE
- End Sub
- Private Sub Class_Terminate()
- 'Delete console
- CloseHandle hConsoleOut
- CloseHandle hConsoleIn
- FreeConsole
- End Sub
- Private Function DOSToWin(sourstr$) As String
- DOSToWin = Space$(Len(sourstr))
- OemToChar sourstr, DOSToWin
- End Function
- Private Function WinToDOS(sourstr$) As String
- WinToDOS = Space$(Len(sourstr))
- CharToOem sourstr, WinToDOS
- End Function
- Public Sub ConsoleWriteLine(sInput As String)
- ConsoleWrite sInput & vbCrLf
- End Sub
- Public Sub ConsoleWrite(sInput As String)
- Dim cWritten As Long
- WriteConsole hConsoleOut, ByVal WinToDOS(sInput), Len(sInput), cWritten, ByVal 0&
- End Sub
- Public Function ConsoleReadLine() As String
- Dim ZeroPos As Long
- 'Create a buffer
- ConsoleReadLine = String(255, 0)
- 'Read the input
- ReadConsole hConsoleIn, ConsoleReadLine, Len(ConsoleReadLine), vbNull, vbNull
- 'Strip off trailing vbCrLf and Chr$(0)'s
- ZeroPos = InStr(ConsoleReadLine, Chr$(0))
- If ZeroPos > 0 Then ConsoleReadLine = DOSToWin(Left$(ConsoleReadLine, ZeroPos - 3))
- End Function
...и тишина....
все молчат, тогда так, какой тут код поставить чтоб
взвамодействовать с окном консоли, причем в
скрытом режиме
пробывал черезSendKeys
, компьютер виснет приходилось из розетки выключать 2 попытки уже сделал
Листинг программы
- Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
- Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
- Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
- Dim hProc&, hShell&, Path34$, n&
- Sub main()
- 'hShell = Shell("cmd.exe", 0) 'Скрытый режим !
- MsgBox "для выхода можно ввести ""Exit""" & " и Enter"
- hShell = Shell("cmd.exe", 1)
- hProc = OpenProcess(&H100000, False, hShell)
- While WaitForSingleObject(hProc, 100)
- '
- 'Что требуется здесь вписать чтоб передать консоле инфу..
- 'и получить ответ...
- 'С условием что консоль будет скрыта ???
- '
- Debug.Print n: n = n + 1
- Wend
- CloseHandle hProc
- End Sub
Решение задачи: «Работа с консолью из VB6»
textual
Листинг программы
- Private sinp As Scripting.TextStream
- Private sout As Scripting.TextStream
- Private serr As Scripting.TextStream
- Sub main
- Set myFSO = New Scripting.FileSystemObject
- Set sinp = myFSO.GetStandardStream(CLng(0))
- Set sout = myFSO.GetStandardStream(CLng(1))
- Set serr = myFSO.GetStandardStream(CLng(2))
- '::: Теперь читай из sinp и пиши в sout
- End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д