在模块里作如下声明,调用ExecCmd函数搞定。Option ExplicitPrivate 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 Declare Function dcWaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Declare Function dcCreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As LongPrivate Declare Function dcCloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As LongPrivate Declare Function dcGetExitCodeProcess Lib "kernel32" Alias "GetExitCodeProcess" (ByVal hProcess As Long, lpExitCode As Long) As LongPrivate Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long
On Error GoTo errExit
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
' Start the shelled application:
ret = dcCreateProcess(0&, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
' Wait for the shelled application to finish:
ret = dcWaitForSingleObject(proc.hProcess, INFINITE)
If ret = WAIT_TIMEOUT Then
'After 15 min program may be hung?
Call dcTerminateProcess(proc.hProcess, enAllFail)
End If
Call dcGetExitCodeProcess(proc.hProcess, ret&)
Call dcCloseHandle(proc.hProcess)
ExecCmd = ret&
Exit Function
errExit:
'Error handler here
End Function
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 Declare Function dcWaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Declare Function dcCreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As LongPrivate Declare Function dcCloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As LongPrivate Declare Function dcGetExitCodeProcess Lib "kernel32" Alias "GetExitCodeProcess" (ByVal hProcess As Long, lpExitCode As Long) As LongPrivate Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long
On Error GoTo errExit
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
' Start the shelled application:
ret = dcCreateProcess(0&, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
' Wait for the shelled application to finish:
ret = dcWaitForSingleObject(proc.hProcess, INFINITE)
If ret = WAIT_TIMEOUT Then
'After 15 min program may be hung?
Call dcTerminateProcess(proc.hProcess, enAllFail)
End If
Call dcGetExitCodeProcess(proc.hProcess, ret&)
Call dcCloseHandle(proc.hProcess)
ExecCmd = ret&
Exit Function
errExit:
'Error handler here
End Function
解决方案 »
- 如何在代码中设定mshflexgrid的各个列名(列的名称,宽度等) (本人是一名新手VB程序员,请各位指教)
- 关于mschart的问题?急!
- 关于数据库中的繁体字符的显示问题
- 除了mshflexgrid.colwidth(i)=0,还有什么办法使mshflexgrid的第i列不可见??
- INSTALL SHEILD 哪里有下载 ???
- 谁能帮我解释一下关于vb6中的隐藏指针问题??
- 请教各位大虾
- 怎么给菜单披上XP的皮???
- 用VB是否可以监视打印机的状态(是否处于打印)
- 关于编译的问题。
- 如何打包VB6编译的程序?(引用了ExcelXP对象)
- 关于CommonDialog控件Filter属性的问题!
请你再帮着修改一下。
另外,想问一下,dcWaitForSingleObject、dcCreateProcess等这些函数,我在哪里可以查到它们的用法?
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 Declare Function dcWaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Declare Function dcCreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As LongPrivate Declare Function dcCloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As LongPrivate Declare Function dcGetExitCodeProcess Lib "kernel32" Alias "GetExitCodeProcess" (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function dcTerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As LongPrivate Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Const WAIT_TIMEOUT As Long = &H102Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long
Dim enAllFail As Long
On Error GoTo errExit
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
' Start the shelled application:
ret = dcCreateProcess(0&, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
' Wait for the shelled application to finish:
ret = dcWaitForSingleObject(proc.hProcess, INFINITE)
If ret = WAIT_TIMEOUT Then
'After 15 min program may be hung?
Call dcTerminateProcess(proc.hProcess, enAllFail)
End If
Call dcGetExitCodeProcess(proc.hProcess, ret&)
Call dcCloseHandle(proc.hProcess)
ExecCmd = ret&
Exit Function
errExit:
'Error handler here
End Function
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const INFINITE = -1&
Const SYNCHRONIZE = &H100000Dim iTask As Long, ret As Long, pHandle As Long
iTask = Shell("C:\外部应用程序.EXE", 0)
pHandle = OpenProcess(SYNCHRONIZE, False, iTask)
ret = WaitForSingleObject(pHandle, INFINITE)
ret = CloseHandle(pHandle)