eHandle PipeR4OutputChannel
CloseHandle PipeW4OutputChannel
InitDosIO = ERROR_DUP_WRITE_HANDLE
Exit Function
End If
Ret = CloseHandle(PipeW4InputChannel)
If Ret = 0 Then
MsgBox "close handle eerr"
End If
Ret = DuplicateHandle(GetCurrentProcess(), PipeR4OutputChannel, GetCurrentProcess(), hOutputHandle, 0, True, DUPLICATE_SAME_ACCESS)
If Ret = 0 Then ''''转换读句柄
CloseHandle PipeR4InputChannel
CloseHandle PipeW4InputChannel
CloseHandle PipeR4OutputChannel
CloseHandle PipeW4OutputChannel
InitDosIO = ERROR_DUP_READ_HANDLE
Exit Function
End If
Ret = CloseHandle(PipeR4OutputChannel)
If Ret = 0 Then
MsgBox "close handle 2 er"
End If
Dim Start As STARTUPINFO, CmdStr As String
Start.cb = Len(Start)
Start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
Start.hStdOutput = PipeW4OutputChannel
Start.hStdError = PipeW4OutputChannel
Start.hStdInput = PipeR4InputChannel
CmdStr = "CMD"
Ret& = CreateProcessA(0&, CmdStr, Sa, Sa, True, NORMAL_PRIORITY_CLASS, 0&, 0&, Start, Proc)
If Ret <> 1 Then ''''建立控制进程
CloseHandle PipeR4InputChannel
CloseHandle PipeW4InputChannel
CloseHandle PipeR4OutputChannel
CloseHandle PipeW4OutputChannel
InitDosIO = ERROR_CREATE_CHILD_PROCESS
Exit Function
End If
End Function
Public Function DosInput(ByVal Str As String) As InputResult
Dim Btarray As String, Buflen As Long, BtWritten As Long, Rtn As Long
Dim BtTest() As Byte
Btarray = StrConv(Str + vbCrLf, vbFromUnicode)
BtTest = StrConv(Str + vbCrLf, vbFromUnicode)
Buflen = LenB(Btarray)
Rtn = WriteFile(hInputHandle, StrPtr(BtTest), Buflen, BtWritten, ByVal 0&)
If BtWritten = 0 Then
DosInput = ERROR_WRITE_INFO
Exit Function
End If
DosInput = 0
End Function
Public Function DosOutput(ByRef StrOutput As String) As OutputResult
Dim Ret As Long, TmpBuf As String * 128, BtRead As Long, BtTotal As Long, BtLeft As Long
Rtn = PeekNamedPipe(hOutputHandle, StrPtr(TmpBuf), 128, BtRead, BtTotal, BtLeft)
If Rtn = 0 Then ''''查询信息量
DosOutput = ERROR_QUERY_INFO_SIZE
Exit Function
End If
If BtTotal = 0 Then ''''若信息为空，则退出
DosOutput = ERROR_ZERO_INFO_SIZE
Exit Function
End If
Dim Btbuf() As Byte, BtReaded As Long
ReDim Btbuf(BtTotal)
Ret = ReadFile(hOutputHandle, VarPtr(Btbuf(0)), BtTotal, lngbytesread, 0&)
If Ret = 0 Then
DosOutput = ERROR_READ_INFO
Exit Function
End If
If BtTotal <> lngbytesread Then
DosOutput = ERROR_UNEQUAL_INFO_SIZE
End If
Dim strBuf As String
strBuf = StrConv(Btbuf, vbUnicode)
Debug.Print strBuf
StrOutput = strBuf
End Function
Public Function EndDosIo() As Long
Dim Ret As Long
CloseHandle PipeR4InputChannel
CloseHandle PipeW4InputChannel
CloseHandle PipeR4OutputChannel
CloseHandle PipeW4OutputChannel
CloseHandle Proc.hThread
CloseHandle Proc.hProcess
If EndProcess(Proc.dwProcessId) = False Then
MsgBox "主服务程序[CMD.EXE]没有关闭，请您手动关闭 ", vbInformation, "不好意思"
End If
End Function
Public Function EndProcess(ByVal ProcessID As Long) As Boolean
Dim hProcess As Long, ExitCode As Long, Rst As Long
hProcess = OpenProcess(PROCESS_TERMINATE Or PROCESS_QUERY_INFORMATION, True, ProcessID)
If hProcess <> 0 Then
GetExitCodeProcess hProcess, ExitCode
If ExitCode <> 0 Then
Rst = TerminateProcess(hProcess, ExitCode)
CloseHandle hProcess
If Rst = 0 Then
EndProcess = False
Else
EndProcess = True
End If
Else
EndProcess = False
End If
Else
EndProcess = False
End If
End Function
------------------------------------------------------窗体代码---------------------------------------
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 ''''Fixed Single
Caption = "控制台管道重定向 "
ClientHeight = 4620
ClientLeft = 45
ClientTop = 330
ClientWidth = 8820
LinkTopic = "Form1"
MaxButton = 0 ''''False
ScaleHeight = 4620
ScaleWidth = 8820
StartUpPosition = 3 ''''Windows Default
Begin VB.CommandButton cmdget
Caption = "获取控制台输出字符 "
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 ''''False
Italic = 0 ''''False
Strikethrough = 0 ''''False
EndProperty
Height = 360
Left = 1830
TabIndex = 4
Top = 4245
Width = 4575
End
Begin VB.CommandButton cmdExe
Caption = "命令写入控制台"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 ''''False
Italic = 0 ''''False
Strikethrough = 0 ''''False
EndProperty
Height = 375
Left = 6720
TabIndex = 3
Top &nbs 上一页 [1] [2] [3] 下一页 |
