分不多140分送上，麻烦帮我看下这个问题，谢谢谢谢谢谢谢
本帖最后由 xunis 于 2012-12-26 18:35:21 编辑 想-实-现ActiveX控-件-调-用-C++写-的-exe并-抓-取-输-出-到-控-制-台-的-消-息
之-前-开-过-一-贴-可-能-没-描-述-清-楚，现-在-重-新-贴-代-码-开-贴！
http://bbs.csdn.net/topics/390326659
。。。。。。分-不-多 上-限-只-能-是100 多-多-包-涵 谢-谢。。。。。。
提示我有非法字符 我去！ 也不说是那个字符 找死我
'模块中
Public Const NORMAL_PRIORITY_CLASS = &H20&
Public Const STARTF_USESHOWWINDOW = &H1
Public Const STARTF_USESTDHANDLES = &H100
Public Const SW_HIDE = 0
Public Const SW_DISPLAY = 1
Public Const EM_SETSEL = &HB1
Public Const EM_REPLACESEL = &HC2
Public Const EM_LINEINDEX = &HBB
'这个API没用到
Public Declare Function CreateThread Lib "kernel32" _
(lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, _
ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long
Public Declare Function CreatePipe Lib "kernel32 " (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Public Declare Sub GetStartupInfo Lib "kernel32 " Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
Public 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
Public Declare Function SetWindowText Lib "user32 " Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function ReadFile Lib "kernel32 " (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Public Declare Function SendMessage Lib "user32 " Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function CloseHandle Lib "kernel32 " (ByVal hObject As Long) As Long
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Public 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
Public Type OVERLAPPED
ternal As Long
ternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type
'form中的代码 最后form生成exe 用 ActiveX控件调用exe
Private Sub run_Click()
Dim exePath
Dim tmpPath
Dim P1 As String
P1 = App.Path
exePath = P1 & IIf(Right(P1, 1) = "", "", "") & "eload\eloader.exe"
' exePath = P1 & IIf(Right(P1, 1) = "", "", "") & "eload\testspace.exe"
tmpPath = P1 & IIf(Right(P1, 1) = "", "", "") & "tmp.txt"
' exePath = "E:\msgok.exe"
MsgBox "~~~~~~~~~~~~~" + ExecuteApp(exePath)
End Sub
Private Function ExecuteApp(ByVal sCmdline As String) As String
Dim proc As PROCESS_INFORMATION, ret As Long
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As Long '负责读取的管道
Dim hWritePipe As Long '负责Shell程序的标准输出和标准错误输出的管道
Dim sOutput As String '放返回的数据
Dim lngBytesRead As Long, sBuffer As String * 256
sa.nLength = Len(sa)
sa.bInheritHandle = True
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
MsgBox "CreatePipe failed. Error: " & Err.LastDllError
Exit Function
End If
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW ' 把标准输出和标准错误输出重定向到同一个管道中去。
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
start.wShowWindow = SW_DISPLAY '隐含shell程序窗口
' 启动shell程序, sCmdLine指明执行的路径
CreateProcess(sCmdline, "", sa, sa, True, 0, 0, vbNullString, start, proc)
If ret = 0 Then
MsgBox "无法建立新进程，错误码：" & Err.LastDllError
Exit Function
End If ' 本例中不必向shell程序送信息，因此可以先关闭hWritePipe
CloseHandle hWritePipe ' 循环读取shell程序的输出，每次读取256个字节。
Do
MsgBox Err.LastDllError '结果=0
ret = ReadFile(hReadPipe, sBuffer, 256, lngBytesRead, 0&)
MsgBox Err.LastDllError '结果=6
MsgBox GetLastError '结果=0
'我查询API帮助文档发现 6 表示 ERROR_INVALID_HANDLE 应该说的是hReadPipe
'我查询http://www.vbgood.com/api-createprocess.html看到CreateProcess API
'lpProcessInformation参数的表述是"PROCESS_INFORMATION，该结构用于容纳新进
'程的进程和线程标识符。大多数情况下，一旦这个函数返回，父应用程序都会关闭两个句柄。"
'难道与这个有关吗？
'
'上面代码中创建管道和创建进程的返回值都<>0 读取文件的返回值=0
'
sOutput = sOutput & Left$(sBuffer, lngBytesRead)
Loop While ret <> 0 ' 如果ret=0代表没有更多的信息需要读取了
' 释放相关资源
CloseHandle proc.hProcess
CloseHandle proc.hThread
CloseHandle hReadPipe
ExecuteApp = sOutput ' 输出结果
End Function
Dim sa As SECURITY_ATTRIBUTES, si As STARTUPINFO, pi As PROCESS_INFORMATION
sa.nLength = Len(sa)
sa.bInheritHandle = True
si.cb = Len(si)
Res = CreateProcess(ApplicationName, CommandLine, sa, sa, True, NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, si, pi)
If Res = 0 Then
information = MsgBox("不能创建子进程！", vbOKOnly + vbExclamation + vbSystemModal, "创建进程提示")
End If
'''''''''''''''''''''''
CloseHandle pi.hProcess
CloseHandle pi.hThread
