' 撰寫人：Devil(璉璉)  E-Mail: qvb3377@ms5.hinet.net  僅供學術測試使用，引用請註明原出處
' --------------------------------------------------------------------------------------
Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateProcess Lib "Kernel32.dll" 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
Private Declare Function EmptyWorkingSet Lib "Psapi.dll" (ByVal hProcess As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwAccess As Long, ByVal fInherit As Integer, ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "Kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function WaitForInputIdle Lib "user32.dll" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function WaitForSingleObject Lib "Kernel32.dll" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeProcess Lib "Kernel32.dll" (ByVal hProcess As Long, ByRef lpExitCode As Long) As Long

Private Declare Function GetLastError Lib "Kernel32.dll" () As Long

' modTime
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long

'' ShowWindow API
'Public Enum enuShowWindow
'   SW_MAXIMIZE = 3
'   SW_MINIMIZE = 6
'   SW_RESTORE = 9
'   SW_HIDE = 0
'   SW_SHOWNA = 8
'   SW_SHOWNOACTIVATE = 4
'   SW_SHOWNORMAL = 1
'   SW_SHOWMINNOACTIVE = 7
'End Enum
'
Private Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Long
End Type

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
   ProcessId As Long
   ThreadId As Long
End Type

Private Type processValue
   hWndMain As Long
   IsExit As Boolean
   ExitCode As Long
   WaitMilliseconds As Double
End Type

'Const SYNCHRONIZE = 1048576
Private Const NORMAL_PRIORITY_CLASS As Long = &H20&
Private Const INFINITE As Long = -1      '  Infinite timeout
Private Const STATUS_PENDING As Long = &H103&
Private Const STILL_ACTIVE As Long = STATUS_PENDING
Private Const STARTF_USESHOWWINDOW As Long = &H1
Private Const STARTF_USESTDHANDLES As Long = &H100&


'用來存放屬性值的區域變數
Private pi As PROCESS_INFORMATION
Private pv As processValue
Private cPerformanceFrequency As Currency

Friend Function Start(ByVal ExeFile As String, Optional ByVal CommandLine As String = vbNullString, Optional ByVal WorkDirectory As String = vbNullString, Optional ByVal ShowWindowFlags As enuShowWindow = SW_SHOWNORMAL, Optional ByVal TimeoutMilliseconds As Double = -1) As cProcess
   Dim sInfo As STARTUPINFO
   Dim sNull As String
   Dim npv As processValue
   Dim sec1 As SECURITY_ATTRIBUTES, sec2 As SECURITY_ATTRIBUTES
   
   sec1.nLength = Len(sec1)
   sec2.nLength = Len(sec2)
   sInfo.cb = Len(sInfo)
   sInfo.dwFlags = STARTF_USESHOWWINDOW
   sInfo.wShowWindow = ShowWindowFlags
   pv = npv
   
   ' lSuccess = CreateProcess(ExeFile, CommandLine, sec1, sec2, True, NORMAL_PRIORITY_CLASS, 0&, WorkDirectory, sInfo, pi) ' WinXP 不支援，Win7 支援
   lSuccess = CreateProcess(vbNullString, ExeFile & " " & CommandLine, ByVal 0&, ByVal 0&, True, NORMAL_PRIORITY_CLASS, 0&, WorkDirectory, sInfo, pi) ' WinXP 支援
   If lSuccess = 0 Then errCode = GetLastError
   CheckExitCode
   
   If TimeoutMilliseconds > 0 Then
      Dim tf As Currency, sc As Currency, nc As Currency
      tf = cPerformanceFrequency * TimeoutMilliseconds / 1000
      QueryPerformanceCounter sc
   
      Do
         DoEvents
         WaitForExit 1
         QueryPerformanceCounter nc
         If pv.IsExit Then
            Exit Do
         ElseIf (nc - sc) > tf Then
            CloseMainWindow
            If Not pv.IsExit Then Kill
            Exit Do
         End If
      Loop
      
      pv.WaitMilliseconds = (nc - sc) / cPerformanceFrequency
   End If

   Set Start = Me
End Function

Friend Function CloseMainWindow() As Boolean
   If Not pv.IsExit Then
      CloseMainWindow = SendCloseWindowMessage(MainWindowHandle)
      CheckExitCode
   Else
      CloseMainWindow = True
   End If
End Function

Friend Function Kill() As Boolean
   If Not pv.IsExit Then
      lRetValue = TerminateProcess(pi.hProcess, 0&)
      CheckExitCode
      CloseProcess
   End If
   Kill = pv.IsExit
End Function

Friend Sub EmptyWorkSet()
   EmptyWorkingSet pi.hProcess
End Sub

Friend Function WaitForExit(Optional ByVal Milliseconds As Long = INFINITE) As Boolean
   ' 等候至結束，傳回等待時間，預設無限等待
   Dim sc As Currency, nc As Currency
   QueryPerformanceCounter sc
   
   DoEvents
   WaitForSingleObject pi.hProcess, Milliseconds
   
   QueryPerformanceCounter nc
   pv.WaitMilliseconds = (nc - sc) / cPerformanceFrequency
   CheckExitCode
   WaitForExit = pv.IsExit
End Function

Friend Function WaitForIdle(Optional ByVal Milliseconds As Long = INFINITE) As Boolean
   ' 等候至閒置，傳回等待時間，預設無限等待
   Dim sc As Currency, nc As Currency
   QueryPerformanceCounter sc
   
   DoEvents
   WaitForInputIdle pi.hProcess, Milliseconds
   
   QueryPerformanceCounter nc
   pv.WaitMilliseconds = (nc - sc) / cPerformanceFrequency
   CheckExitCode
   WaitForIdle = pv.IsExit
End Function

Friend Sub CloseProcess()
   lRetValue = CloseHandle(pi.hThread)
   lRetValue = CloseHandle(pi.hProcess)
End Sub

Friend Property Get ExitCode() As Long
   CheckExitCode
   ExitCode = pv.ExitCode
End Property

Friend Property Get HasExited() As Boolean
   CheckExitCode
   HasExited = pv.IsExit
End Property

Friend Property Get MainWindowHandle() As Long
   If Not HasExited Then
      If pv.hWndMain = 0 Then
         On Error Resume Next
         arrThreadIdWnd = myEnumThreadWindows(pi.ThreadId)
         For ibw = LBound(arrThreadIdWnd) To UBound(arrThreadIdWnd)
            If GetWindow(arrThreadIdWnd(ibw), GW_OWNER) = 0 Then
               If IsWindowVisible(arrThreadIdWnd(ibw)) Then
                  pv.hWndMain = arrThreadIdWnd(ibw)
                  Exit For
               End If
            End If
         Next
         On Error GoTo 0
      End If
   End If
   
   MainWindowHandle = pv.hWndMain
End Property

Friend Property Get MainThreadId() As Long
   ThreadId = pi.ThreadId
End Property

Friend Property Get hMainThread() As Long
   hThread = pi.hThread
End Property

Friend Property Get Id() As Long
   ProcessId = pi.ProcessId
End Property

Friend Property Get Handle() As Long
   hProcess = pi.hProcess
End Property

Friend Property Get WaitMilliseconds() As Long
   WaitMilliseconds = pv.WaitMilliseconds
End Property

Private Sub CheckExitCode()
   If Not pv.IsExit Then
      If GetExitCodeProcess(pi.hProcess, pv.ExitCode) Then
         Select Case pv.ExitCode
         Case STILL_ACTIVE
            pv.IsExit = False
         Case Else
            pv.IsExit = True
            pv.hWndMain = 0
            CloseProcess
         End Select
      End If
   End If
End Sub

Private Sub Class_Initialize()
   QueryPerformanceFrequency cPerformanceFrequency
End Sub

Private Sub Class_Terminate()
   CloseProcess
End Sub