Работа с консолью из VB6

Узнай цену своей работы

Формулировка задачи:

Вот модуль класса, который я смонтировал, черпая инфу из самых разнообразных источников... который запускает консоль и даёт возможность вставлять туда свой текст...
Листинг программы
  1. Sub main()
  2. Dim cons As New Console
  3. ' ConsoleWriteLine "Привет пиплы :)"
  4. cons.ConsoleWriteLine "Echo on"
  5. cons.ConsoleWriteLine "regsvr32 dllERR.dll"
  6. Debug.Print cons.ConsoleReadLine
  7. End Sub
теперь вопросы...
  • Как заставить такую консоль реально выполнять комманды ?
  • почему, не функционирует ReadLine ?.. собственно из за нее и делаю...
  • как настроить параметр запуск в скрытом режиме... ?
  • можно ли какнибудь подменить используемые хендлы, на Хэндл

    Shell("cmd.exe")

Листинг программы
  1. Option Explicit
  2. '
  3. '© FelixMacintosh 2014
  4. 'Работа с консолью с возможностью ввода/вывода русских символов
  5. '
  6. Private Const FOREGROUND_BLUE = &H1
  7. Private Const FOREGROUND_GREEN = &H2
  8. Private Const FOREGROUND_RED = &H4
  9. Private Const BACKGROUND_BLUE = &H10
  10. Private Const BACKGROUND_GREEN = &H20
  11. Private Const BACKGROUND_RED = &H40
  12. Private Const BACKGROUND_INTENSITY = &H80&
  13. Private Const BACKGROUND_SEARCH = &H20&
  14. Private Const FOREGROUND_INTENSITY = &H8&
  15. Private Const FOREGROUND_SEARCH = (&H10&)
  16. Private Const ENABLE_LINE_INPUT = &H2&
  17. Private Const ENABLE_ECHO_INPUT = &H4&
  18. Private Const ENABLE_MOUSE_INPUT = &H10&
  19. Private Const ENABLE_PROCESSED_INPUT = &H1&
  20. Private Const ENABLE_WINDOW_INPUT = &H8&
  21. Private Const ENABLE_PROCESSED_OUTPUT = &H1&
  22. Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2&
  23. Private Const STD_OUTPUT_HANDLE = -11&
  24. Private Const STD_INPUT_HANDLE = -10&
  25. Private Const STD_ERROR_HANDLE = -12&
  26. Private Const INVALID_HANDLE_VALUE = -1&
  27. Private Declare Function AllocConsole Lib "kernel32" () As Long
  28. Private Declare Function FreeConsole Lib "kernel32" () As Long
  29. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  30. Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
  31. 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
  32. 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
  33. Private Declare Function SetConsoleTextAttribute Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal wAttributes As Long) As Long
  34. Private Declare Function SetConsoleTitle Lib "kernel32" Alias "SetConsoleTitleA" (ByVal lpConsoleTitle As String) As Long
  35. Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
  36. Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
  37. Private hConsoleOut As Long, hConsoleIn As Long, hConsoleErr As Long
  38. Private Sub Class_Initialize()
  39. If AllocConsole() Then
  40. hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
  41. If hConsoleOut = INVALID_HANDLE_VALUE Then MsgBox "Не удается получить STDOUT"
  42. hConsoleIn = GetStdHandle(STD_INPUT_HANDLE)
  43. If hConsoleOut = INVALID_HANDLE_VALUE Then MsgBox "Не удается получить STDIN"
  44. Else
  45. MsgBox "Невозможно запустить вторую копию консоли"
  46. End If
  47. 'Установить заголовок окна консоли
  48. SetConsoleTitle App.EXEName & "Copyright (c) FelixMacintosh 2014"
  49. 'Задать синий фона текста в консоли с ярко-желтыми символами
  50. SetConsoleTextAttribute hConsoleOut, FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_INTENSITY _
  51. Or BACKGROUND_BLUE
  52. End Sub
  53. Private Sub Class_Terminate()
  54. 'Delete console
  55. CloseHandle hConsoleOut
  56. CloseHandle hConsoleIn
  57. FreeConsole
  58. End Sub
  59. Private Function DOSToWin(sourstr$) As String
  60. DOSToWin = Space$(Len(sourstr))
  61. OemToChar sourstr, DOSToWin
  62. End Function
  63. Private Function WinToDOS(sourstr$) As String
  64. WinToDOS = Space$(Len(sourstr))
  65. CharToOem sourstr, WinToDOS
  66. End Function
  67.  
  68. Public Sub ConsoleWriteLine(sInput As String)
  69. ConsoleWrite sInput & vbCrLf
  70. End Sub
  71. Public Sub ConsoleWrite(sInput As String)
  72. Dim cWritten As Long
  73. WriteConsole hConsoleOut, ByVal WinToDOS(sInput), Len(sInput), cWritten, ByVal 0&
  74. End Sub
  75. Public Function ConsoleReadLine() As String
  76. Dim ZeroPos As Long
  77. 'Create a buffer
  78. ConsoleReadLine = String(255, 0)
  79. 'Read the input
  80. ReadConsole hConsoleIn, ConsoleReadLine, Len(ConsoleReadLine), vbNull, vbNull
  81. 'Strip off trailing vbCrLf and Chr$(0)'s
  82. ZeroPos = InStr(ConsoleReadLine, Chr$(0))
  83. If ZeroPos > 0 Then ConsoleReadLine = DOSToWin(Left$(ConsoleReadLine, ZeroPos - 3))
  84. End Function
...и тишина.... все молчат, тогда так, какой тут код поставить чтоб взвамодействовать с окном консоли, причем в

скрытом режиме

пробывал через

SendKeys

, компьютер виснет приходилось из розетки выключать 2 попытки уже сделал
Листинг программы
  1. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  2. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  3. Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
  4. Dim hProc&, hShell&, Path34$, n&
  5. Sub main()
  6. 'hShell = Shell("cmd.exe", 0) 'Скрытый режим !
  7. MsgBox "для выхода можно ввести ""Exit""" & " и Enter"
  8. hShell = Shell("cmd.exe", 1)
  9. hProc = OpenProcess(&H100000, False, hShell)
  10. While WaitForSingleObject(hProc, 100)
  11. '
  12. 'Что требуется здесь вписать чтоб передать консоле инфу..
  13. 'и получить ответ...
  14. 'С условием что консоль будет скрыта ???
  15. '
  16. Debug.Print n: n = n + 1
  17. Wend
  18. CloseHandle hProc
  19. End Sub

Решение задачи: «Работа с консолью из VB6»

textual
Листинг программы
  1. Private sinp    As Scripting.TextStream
  2. Private sout    As Scripting.TextStream
  3. Private serr    As Scripting.TextStream
  4.  
  5. Sub main
  6.  
  7.     Set myFSO = New Scripting.FileSystemObject
  8.  
  9.     Set sinp = myFSO.GetStandardStream(CLng(0))
  10.    
  11.     Set sout = myFSO.GetStandardStream(CLng(1))
  12.      
  13.     Set serr = myFSO.GetStandardStream(CLng(2))
  14.  
  15.    '::: Теперь читай из sinp и пиши в sout
  16.  
  17. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

14   голосов , оценка 3.857 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут