昨天xingnup (黑猫)发了个贴子问关于如何取得进程句柄的问题。
http://community.csdn.net/Expert/topic/4351/4351488.xml?temp=.4895746
后来讨论讨论着演化出一个新的问题:如何对CMD窗口进行输入输出重定向?这个问题我记得很久以前就有人讨论过,在原贴中我也说了,最好的办法是用管道。
说实话,这东西确实用VC做起来比较舒服,启一个线程不断从管道中读取CMD窗口的输出,然后再进行处理就OK了。但VB做起来就得有些变通的地方,不过还好,代码没有我想象中的那么别扭。xingnup(黑猫)如果需要的话可以实行“拿来主义”,当然也希望我的代码对大家都有帮助。
有什么不妥当的地方还希望大家提出宝贵意见。 :)下面进入正题:
两个TextBox,txtCommand用于输入命令,txtMessage用于获得CMD窗口输出的内容。Option ExplicitPrivate Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function SetHandleInformation Lib "kernel32" (ByVal hObject As Long, ByVal dwMask As Long, ByVal dwFlags As Long) As Long
Private Declare Function SetNamedPipeHandleState Lib "kernel32" (ByVal hNamedPipe As Long, lpMode As Long, lpMaxCollectionCount As Long, lpCollectDataTimeout As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
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 Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End TypePrivate Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End TypePrivate Const STARTF_USESTDHANDLES = &H100
Private Const HANDLE_FLAG_INHERIT = 1
Private Const DETACHED_PROCESS = &H8
Private Const PIPE_NOWAIT = &H1Dim hReadPipe As Long
Dim hWritePipe As Long
Dim hChildReadPipe As Long
Dim hChildWritePipe As LongPrivate Sub Form_Load()
txtCommand.Text = ""
txtMessage.Text = ""
txtMessage.Locked = True
' 创建管道
CreatePipe hReadPipe, hWritePipe, ByVal 0, ByVal 0
CreatePipe hChildReadPipe, hChildWritePipe, ByVal 0, ByVal 0
SetHandleInformation hWritePipe, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT
SetHandleInformation hChildReadPipe, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT
Dim dwMode As Long
dwMode = PIPE_NOWAIT
SetNamedPipeHandleState hReadPipe, dwMode, ByVal 0, ByVal 0
' 创建CMD进程
Dim stProcessInfo As PROCESS_INFORMATION
Dim stStartInfo As STARTUPINFO
stStartInfo.cb = LenB(stStartInfo)
stStartInfo.dwFlags = STARTF_USESTDHANDLES
stStartInfo.hStdError = hWritePipe
stStartInfo.hStdOutput = hWritePipe
stStartInfo.hStdInput = hChildReadPipe
Dim strExe As String
strExe = "cmd"
If False = CreateProcess(ByVal vbNullString, ByVal strExe, ByVal 0, ByVal 0, ByVal True, ByVal DETACHED_PROCESS, ByVal 0, ByVal vbNullString, stStartInfo, stProcessInfo) Then
MsgBox "启动进程失败!"
Exit Sub
Else
CloseHandle stProcessInfo.hThread
CloseHandle stProcessInfo.hProcess
End If
ReadFromChildPipe
End SubPrivate Sub Form_Unload(Cancel As Integer)
CloseHandle hReadPipe
CloseHandle hWritePipe
CloseHandle hChildReadPipe
CloseHandle hChildWritePipe
End SubPrivate Sub txtCommand_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
Dim nWrite As Long
Dim strBuffer As String
strBuffer = txtCommand.Text & vbCrLf
Dim bResult As Boolean
bResult = WriteFile(ByVal hChildWritePipe, ByVal strBuffer, ByVal Len(strBuffer), nWrite, ByVal 0)
If bResult = True Then
ReadFromChildPipe
Else
MsgBox "写入失败."
End If
txtCommand.Text = ""
End If
End SubPrivate Sub ReadFromChildPipe()
Dim nRead As Long
Dim strBuffer As String
Dim nBufferLen As Long
nRead = -1
Do While nRead <> 0
nBufferLen = 65536
strBuffer = String(nBufferLen, Chr(0))
Sleep 10
ReadFile hReadPipe, ByVal strBuffer, ByVal nBufferLen, nRead, ByVal 0
Sleep 10
If nRead <> 0 Then
strBuffer = Left(strBuffer, nRead)
txtMessage.Text = txtMessage.Text & strBuffer
txtMessage.SelStart = Len(txtMessage.Text)
End If
Loop
End Sub
http://community.csdn.net/Expert/topic/4351/4351488.xml?temp=.4895746
后来讨论讨论着演化出一个新的问题:如何对CMD窗口进行输入输出重定向?这个问题我记得很久以前就有人讨论过,在原贴中我也说了,最好的办法是用管道。
说实话,这东西确实用VC做起来比较舒服,启一个线程不断从管道中读取CMD窗口的输出,然后再进行处理就OK了。但VB做起来就得有些变通的地方,不过还好,代码没有我想象中的那么别扭。xingnup(黑猫)如果需要的话可以实行“拿来主义”,当然也希望我的代码对大家都有帮助。
有什么不妥当的地方还希望大家提出宝贵意见。 :)下面进入正题:
两个TextBox,txtCommand用于输入命令,txtMessage用于获得CMD窗口输出的内容。Option ExplicitPrivate Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function SetHandleInformation Lib "kernel32" (ByVal hObject As Long, ByVal dwMask As Long, ByVal dwFlags As Long) As Long
Private Declare Function SetNamedPipeHandleState Lib "kernel32" (ByVal hNamedPipe As Long, lpMode As Long, lpMaxCollectionCount As Long, lpCollectDataTimeout As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
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 Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End TypePrivate Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End TypePrivate Const STARTF_USESTDHANDLES = &H100
Private Const HANDLE_FLAG_INHERIT = 1
Private Const DETACHED_PROCESS = &H8
Private Const PIPE_NOWAIT = &H1Dim hReadPipe As Long
Dim hWritePipe As Long
Dim hChildReadPipe As Long
Dim hChildWritePipe As LongPrivate Sub Form_Load()
txtCommand.Text = ""
txtMessage.Text = ""
txtMessage.Locked = True
' 创建管道
CreatePipe hReadPipe, hWritePipe, ByVal 0, ByVal 0
CreatePipe hChildReadPipe, hChildWritePipe, ByVal 0, ByVal 0
SetHandleInformation hWritePipe, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT
SetHandleInformation hChildReadPipe, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT
Dim dwMode As Long
dwMode = PIPE_NOWAIT
SetNamedPipeHandleState hReadPipe, dwMode, ByVal 0, ByVal 0
' 创建CMD进程
Dim stProcessInfo As PROCESS_INFORMATION
Dim stStartInfo As STARTUPINFO
stStartInfo.cb = LenB(stStartInfo)
stStartInfo.dwFlags = STARTF_USESTDHANDLES
stStartInfo.hStdError = hWritePipe
stStartInfo.hStdOutput = hWritePipe
stStartInfo.hStdInput = hChildReadPipe
Dim strExe As String
strExe = "cmd"
If False = CreateProcess(ByVal vbNullString, ByVal strExe, ByVal 0, ByVal 0, ByVal True, ByVal DETACHED_PROCESS, ByVal 0, ByVal vbNullString, stStartInfo, stProcessInfo) Then
MsgBox "启动进程失败!"
Exit Sub
Else
CloseHandle stProcessInfo.hThread
CloseHandle stProcessInfo.hProcess
End If
ReadFromChildPipe
End SubPrivate Sub Form_Unload(Cancel As Integer)
CloseHandle hReadPipe
CloseHandle hWritePipe
CloseHandle hChildReadPipe
CloseHandle hChildWritePipe
End SubPrivate Sub txtCommand_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
Dim nWrite As Long
Dim strBuffer As String
strBuffer = txtCommand.Text & vbCrLf
Dim bResult As Boolean
bResult = WriteFile(ByVal hChildWritePipe, ByVal strBuffer, ByVal Len(strBuffer), nWrite, ByVal 0)
If bResult = True Then
ReadFromChildPipe
Else
MsgBox "写入失败."
End If
txtCommand.Text = ""
End If
End SubPrivate Sub ReadFromChildPipe()
Dim nRead As Long
Dim strBuffer As String
Dim nBufferLen As Long
nRead = -1
Do While nRead <> 0
nBufferLen = 65536
strBuffer = String(nBufferLen, Chr(0))
Sleep 10
ReadFile hReadPipe, ByVal strBuffer, ByVal nBufferLen, nRead, ByVal 0
Sleep 10
If nRead <> 0 Then
strBuffer = Left(strBuffer, nRead)
txtMessage.Text = txtMessage.Text & strBuffer
txtMessage.SelStart = Len(txtMessage.Text)
End If
Loop
End Sub
看到这个 goodname008 (卢培培,充电中......) 名字
就想起来哪个超酷的右键菜单,可惜不支持多级菜单。呵呵。
很长时间不发贴到是真的,呵呵。那个右键菜单,只要改改就可以支持多级菜单的,以前一直想改,但拖的时间越来越长,就有点懒得改了。本来打算用VC写一个更好的类,但一直没有时间和机会,哎......
以后自己用到再说吧。 :D
也不一定非要看VC,其实把win32 sdk掌握好了就行。
不过要想掌握好win32 sdk,懂C/C++/VC会对win32 sdk有更深的认识。
一个Text1,一个RichTextBox1,一个Timer1
Private Sub Form_Load()
Timer1.Interval = 500
Timer1.Enabled = False
RichTextBox1.Text = ""
End SubPrivate Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim Command As String
Command = "cmd /c " + Text1 + " >C:\command.txt"
If KeyCode = 13 Then
Shell Command, vbHide
Timer1.Enabled = True
End If
End SubPrivate Sub Timer1_Timer()
Open "C:\command.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, LinShi$
RichTextBox1.Text = RichTextBox1.Text + LinShi$ + Chr(10) + Chr(13)
Loop
Close #1
Timer1.Enabled = False
Kill "C:\command.txt"'消灭证据,呵呵
End Sub
就是把CMD里面的内容显示出来而以吗?
没什么实际用处,只是个例程,演示如何实现这个功能。
一方面对xingnup (黑猫)的回答完整一些,另一方面是对这类问题提供一种解决的思路,供大家讨论。这个例程本身没什么实用价值,但这种技术本身是非常有用的。发贴分数和用户等级有关。