首先谢谢三位:
hpygzhx520() 
tztz520(午夜逛街)
rainstormmaster(暴风雨 v2.0) 在调用cpexecute.IsActive时不能达到目的。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 Type
'
Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type'
Private Declare Function CreateProcessA Lib "kernel32" (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 lpCurrentDriectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As LongPrivate Const INFINITE = -1&
Public lProcess As Long
Public lThread As Long
Public Enum ProcPriority
Highest = &H100&
High = &H80&
Normal = &H20&
Lowest = &H40&
End EnumPublic Function execute(ByVal cmdline As String) As Long
If IsActive = False Then
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim lres As Long
start.cb = Len(start)
lres = CreateProcessA(0&, cmdline, 0&, 0&, 1&, &H20&, 0&, 0&, start, proc)
execute = lres
lProcess = proc.hProcess
lThread = proc.hThread
End If
End Function
Public Function IsActive() As Boolean
Dim lres As Long
Call GetExitCodeProcess(lProcess, lres)
If lres = 259 Then
IsActive = True
Else
IsActive = False
End If
End Function
Private Sub class_terminate()
Call CloseHandle(lThread)
Call CloseHandle(lPhread)
End Sub
Public Function SetPriority(ByVal Priority As ProcPriority) As Long
If IsActive = True Then
Dim lres As Long
lres = SetPriorityClass(lProcess, Priority)
SetPriority = lres
End If
End Function
Private Sub Command1_Click()
Dim cpexecute As new Cprocess  
cpexecute.execute "c:\windows\system32\calc.exe"
End SubPrivate Sub Timer1_Timer()
Dim cpexecute As New Cprocess
If cpexecute.IsActive() = False Then
End
End If
End Sub我想等 CALC.EXE 运行完毕自动退出 FORM 但不能达到目的,CALC.EXE 没运行完 FORM 就退出了。
哪儿写错了。怎么写?能写在 Timer1 中吗?谢谢!

解决方案 »

  1.   

    //我想等 CALC.EXE 运行完毕自动退出 FORM 但不能达到目的,CALC.EXE 没运行完 FORM 就退出了。
    哪儿写错了。怎么写?能写在 Timer1 中吗?你换一个事件试试看其实你的问题就是典型的shell & wait问题:
    '窗体上添加2个按钮,运行时你随便点哪一个按钮都能满足你的要求:
    Option ExplicitPrivate Declare Function OpenProcess Lib "kernel32" _
       (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
        ByVal dwProcessId As Long) As Long
    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 GetExitCodeProcess Lib "kernel32" _
       (ByVal hProcess As Long, lpExitCode As Long) As Long
    Private Declare Function TerminateProcess Lib "kernel32" _
       (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
    Private Declare Function GetForegroundWindow Lib "user32" () As Long
    Private Declare Function IsWindow Lib "user32" _
       (ByVal hwnd As Long) As LongConst PROCESS_QUERY_INFORMATION = &H400
    Const SYNCHRONIZE = &H100000
    Const STILL_ALIVE = &H103
    Const INFINITE = &HFFFFPrivate ExitCode As Long
    Private hProcess As Long
    Private isDone As Long
    Private Sub Command1_Click()
    Dim pid As Long
    pid = Shell("calc.exe", vbNormalFocus)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION + SYNCHRONIZE, 0, pid)
    isDone = False
    Do
      Call GetExitCodeProcess(hProcess, ExitCode)
      'Debug.Print ExitCode
      DoEvents
    Loop While ExitCode = STILL_ALIVE
    Call CloseHandle(hProcess)
    isDone = True
    Unload Me
    End Sub
    Private Sub Command2_Click()'推荐这种方法
    Dim pid As Long
    Dim ExitEvent As Long
    pid = Shell("calc.exe", vbNormalFocus)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION + SYNCHRONIZE, 0, pid)
    ExitEvent = WaitForSingleObject(hProcess, INFINITE)
    Call CloseHandle(hProcess)
    Unload Me
    End Sub
      

  2.   

    我的网站上有同步执行程序的代码,我可以看看。VB资料->查询“同步执行”;====================
    免费的学习交流网站,欢迎大家访问!
    http://www.j2soft.cn/