Option Explicit
Private RunFile$
Private Const NORMAL_PRIORITY_CLASS = &H20 如果进程位于前台,则基本值是9;如果在后台,则优先值为7 Private Const INFINITE = &HFFFFFFFF Private Const WAIT_TIMEOUT = &H102& 对象保持未发出信号的状态,但等待超时时间已经超过 Private Flag As Boolean ‘进程活动监视标志
说明∶PROCESS_INFORMATION结构由CreateProcess函数将关于新建立的进程和 主要线索的信息写入其中成员变量 Private Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As Long End Type
说明∶STARTUPINFO结构用在CreateProcess函数中指定为新进程建立的新窗口的主要属性。这一 一信息影响由CreateWindows函数建立的第一个窗口 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 Type
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long,ByVal dwMilliseconds As Long) As Long Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String,ByVal lpCommandLine As String,ByVal lpProcessAttributes As Long,ByVal lpThreadAttributes As Long,ByVal bInheritHandles As Long,ByVal dwCreationFlags As Long,lpEnvironment As Any,ByVal lpCurrentDirectory As String,lpStartupInfo As STARTUPINFO,lpProcessInformation As PROCESS_INFORMATION) As Long Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long,ByVal dwMilliseconds As Long) As Long
Private Sub command1_Click() Dim res& Dim sinfo As STARTUPINFO Dim pinfo As PROCESS_INFORMATION sinfo.cb = Len(sinfo) sinfo.lpReserved = vbNullString sinfo.lpDesktop = vbNullString sinfo.lpTitle = vbNullString sinfo.dwFlags = 0 Label1.Caption = "正在启动程序" Label1.Refresh CreateProcess函数,用于创建一个新的进程 res = CreateProcess(DemoFile,vbNullString,True,_ NORMAL_PRIORITY_CLASS,ByVal 0&,sinfo,pinfo) If res Then Label1.Caption = "程序正在运行中" WaitForTerm pinfo Label1.Caption = "程序已经结束" Else Label1.Caption = "启动程序时出错,可能未正确输入" & Chr(13) & "程序名或程序所在路径。" End If End Sub
Private Sub WaitForTerm(pinfo As PROCESS_INFORMATION) Dim res& Dim res1& 等待指定的进程进入空闲状态,,空闲(Idle)指的是进程准备处理一条消息、但目前暂时没有消息需要处理的一种状态 Call WaitForInputIdle(pinfo.hProcess,INFINITE) Command1.Enabled = False Command2.Enabled = True Label1.Refresh Do If Flag Then Exit Do 等待发出信号 res = WaitForSingleObject(pinfo.hProcess,0) If res <> WAIT_TIMEOUT Then 如果对象发出了信号 command1_Click Exit Do End If DoEvents Debug.Print res Loop While True Command1.Enabled = True Command2.Enabled = False End Sub
Private Sub Command3_Click() Flag = True End Sub
Private Sub Form_Load() RunFile = InputBox$("请输入需要运行的程序名与路经") Flag = False End Sub (编辑:李大同)
【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!
|