clsstartterminateprogram.cls

这个源代码主要模仿了一个类似 深度操作系统安装程序中的一个软件自动安装管理器AutoIt v3

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsStartTerminateProgram"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居出品
'发布日期：2008/07/02
'描    述：软件自动安装管理器 Ver 1.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

'*************************************************************************
'**模 块 名：clsStartTerminateProgram
'**说    明：http://www.mndsoft.com 版权所有2008 - 2009(C)1
'**创 建 人：Mndsoft.com
'**日    期：2008-06-22 17:48:40
'**修 改 人：
'**日    期：
'**描    述：程序运行等待类
'**版    本：V1.0.0
'*************************************************************************



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 Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type


Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
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 lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Private proc As PROCESS_INFORMATION
Private start As STARTUPINFO


Public Function StartProgram(ByVal ProgramName$) As Long
    ret& = CreateProcessA(0&, ProgramName$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
    StartProgram = ret&
End Function

Public Sub KillProgram()
    ret& = TerminateProcess(proc.hProcess, 1)
End Sub
Public Sub WaitForProgramToEnd()
    
    Dim RetVal As Long
    'This line of code will wait for an infinite amount of time
    'until the spawned app closes
    'Not good if GUI involved
    'RetVal = WaitForSingleObject(proc.hProcess, INFINITE)
    
    RetVal = 1
    Do Until RetVal = 0
        RetVal = WaitForSingleObject(proc.hProcess, 750)
        DoEvents: DoEvents: DoEvents:
    Loop
    

End Sub