Option Explicit
Private Declare Function CreatePipe Lib "kernel32.dll" (ByRef phReadPipe As Long, ByRef phWritePipe As Long, ByRef lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Private Declare Function GetStdHandle Lib "kernel32.dll" (ByVal nStdHandle As Long) As Long
Private Declare Function SetStdHandle Lib "kernel32.dll" (ByVal nStdHandle As Long, ByVal nHandle As Long) As Long
Private Declare Function LocalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal wBytes As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function DuplicateHandle Lib "kernel32.dll" (ByVal hSourceProcessHandle As Long, ByVal hSourceHandle As Long, ByVal hTargetProcessHandle As Long, ByRef lpTargetHandle As Long, ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwOptions As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Function CreateProcess Lib "kernel32.dll" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByRef lpProcessAttributes As Any, ByRef lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByRef lpEnvironment As Any, ByVal lpCurrentDriectory As String, ByRef lpStartupInfo As STARTUPINFO, ByRef lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function TerminateProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function PeekNamedPipe Lib "kernel32.dll" (ByVal hNamedPipe As Long, ByRef lpBuffer As Any, ByVal nBufferSize As Long, ByRef lpBytesRead As Long, ByRef lpTotalBytesAvail As Long, ByRef lpBytesLeftThisMessage As Long) As Long
Private Declare Function ReadFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByRef lpOverlapped As Any) As Long
Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByRef lpOverlapped As Any) As Long
Private Const DUPLICATE_SAME_ACCESS As Long = &H2
Private Const STARTF_USESHOWWINDOW As Long = &H1
Private Const STARTF_USESTDHANDLES As Long = &H100
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private hChildStdinRd As Long, hChildStdinWr As Long, hChildStdinWrDup As Long
Private hChildStdoutRd As Long, hChildStdoutWr As Long, hChildStdoutRdDup As Long
Private piProcInfo As PROCESS_INFORMATION
'Pipe is a operation system object that is often used for interprocess communication.
'There can be named and unnamed pipes.
'You've specified that w98 must be supported.
'w98 can create only unnamed pipes, and that pipes are single-directed (no duplex).
'So, we must create 2 pipes - to read and to write.
Private Sub Form_Load()
Dim saAttr As SECURITY_ATTRIBUTES
saAttr.nLength = Len(saAttr)
saAttr.bInheritHandle = 1 'or child process will not get pipe handles
saAttr.lpSecurityDescriptor = 0
' Create a pipe for the child process's STDOUT.
CreatePipe hChildStdoutRd, hChildStdoutWr, saAttr, 0
' Handle inheritance is a technique through which child process gets
' handles it should get.
' Create noninheritable read handle and close the inheritable read
' handle. Child doesn't need that handle - so, it won't get it.
DuplicateHandle GetCurrentProcess, hChildStdoutRd, GetCurrentProcess, hChildStdoutRdDup, 0, 0, DUPLICATE_SAME_ACCESS
'Each handle must be closed when it's not useful any more.
CloseHandle hChildStdoutRd
' Create a pipe for the child process's STDIN.
CreatePipe hChildStdinRd, hChildStdinWr, saAttr, 0
' Duplicate the write handle to the pipe so it is not inherited.
DuplicateHandle GetCurrentProcess, hChildStdinWr, GetCurrentProcess, hChildStdinWrDup, 0, 0, DUPLICATE_SAME_ACCESS
CloseHandle hChildStdinWr
' Now create the child process.
CreateProc
Timer1.Enabled = True
End Sub
Private Sub CreateProc()
Dim siStartInfo As STARTUPINFO
siStartInfo.cb = Len(siStartInfo)
siStartInfo.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
siStartInfo.wShowWindow = 0 'completely hide child
siStartInfo.hStdInput = hChildStdinRd 'explicitly set child's input and output handles
siStartInfo.hStdOutput = hChildStdoutWr
' Create the child process.
If CreateProcess(vbNullString, "crafty-19.3.exe", ByVal 0&, ByVal 0&, 1, 0, ByVal 0&, vbNullString, siStartInfo, piProcInfo) = 0 Then
MsgBox "Cannot run Crafty!", vbCritical
Unload Me
End If
End Sub
Private Sub Timer1_Timer()
Dim b() As Byte, nCount As Long, t As Long
'ReadFile can block execution if there is nothing to read.
'So, check first (PeekNamedPipe never blocks execution).
PeekNamedPipe hChildStdoutRdDup, ByVal 0&, 0, ByVal 0&, nCount, ByVal 0&
If nCount > 0 Then
ReDim b(1 To nCount) 'allocate buffer
ReadFile hChildStdoutRdDup, b(LBound(b)), nCount, t, ByVal 0&
'replace different line breaks.
'Also note that buffer is in ANSI, while VB uses Unicode. We have to explicitly convert it.
txtOutput.Text = txtOutput.Text & StrConv(b, vbUnicode)
txtOutput.SelStart = Len(txtOutput.Text)
End If
End Sub
Private Sub txtInput_KeyPress(KeyAscii As Integer)
Dim b() As Byte, t As Long
If KeyAscii = vbKeyReturn Then 'when ENTER pressed...
'convert from VB format to Crafty's
b = StrConv(txtInput.Text & vbNewLine, vbFromUnicode)
'send it to child.
'child doesn't even know that it's not from keyboard...
WriteFile hChildStdinWrDup, b(LBound(b)), UBound(b) - LBound(b) + 1, t, ByVal 0&
txtInput.Text = vbNullString
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
TerminateProcess piProcInfo.hProcess, 0
CloseHandle piProcInfo.hProcess
CloseHandle piProcInfo.hThread
End Sub
Andrey Fedorov писал(а):А можно и попроще - достаточно посмотреть Help по WshScriptExec Object... Примеры есть в самом Help-e.
kostyanet писал(а):А, вот в чем тут дело. Посмотрел листинг выше - так это оно и есть. Типа копипейщено. Приспособлено, конечно, для своих нужд.
Amed писал(а):sanekz, а это домашнее задание. Найдешь - конфетка твоя.
kostyanet писал(а):А, вот в чем тут дело. Посмотрел листинг выше - так это оно и есть. Типа копипейщено. Приспособлено, конечно, для своих нужд.
Нормально, то есть, шаман так борется за чистоту своего реноме - ему можно копипейстить, а другим, даже в разделе для новичков (у кого меньше 120 постов) - ни-ни.
Ы
kostyanet писал(а):Ну ладно,
kostyanet писал(а):кто удалил и главное - зачем - ссылку на класс DosOutputs, которому, кстати, в обед триста лет. Это вопрос.
kostyanet писал(а):Автору: начните не с поиска ответа, а с вопроса самому себе - в какое место этого кода вам нужно воткнуть имя _вашего_ екзешника.
VVitafresh писал(а):а пригодиться могут (готовые классы, модули и т.д.)
Автору: начните не с поиска ответа, а с вопроса самому себе - в какое место этого кода вам нужно воткнуть имя _вашего_ екзешника.
Private Declare Function ReadConsoleOutput Lib "kernel32.dll" Alias "ReadConsoleOutputA" (ByVal hConsoleOutput As Long, ByRef lpBuffer As CHAR_INFO, ByRef dwBufferSize As COORD, ByRef dwBufferCoord As COORD, ByRef lpReadRegion As SMALL_RECT) As Long
hConsoleOutput
[in] A handle to the console screen buffer. The handle must have the GENERIC_WRITE access right. For more information, see Console Buffer Security and Access Rights.
Сейчас этот форум просматривают: Yandex-бот и гости: 36