Attribute VB_Name = "modShellEx"
' -------------------------------------------------------------------------------
'
'   AVStoDVD - by MrC
'   File: modShellEx.bas
'   Purpose: Shell Execute function and utils
'
' -------------------------------------------------------------------------------


Option Explicit
Option Compare Binary
Option Base 0

' ShellExecute constants
' http://msdn.microsoft.com/library/en-us/shellcc/platform/Shell/reference/functions/shellexecute.asp
Public Enum ENUM_SHELLWINDOWSTYLE
    SW_HIDE = 0
    SW_NORMAL = 1
    SW_MINIMIZED = 2
    SW_MAXIMIZED = 3
    SW_NOACTIVE = 4
    SW_SHOW = 5
    SW_MINIMIZED_NOACTIVE = 7
    SW_NA = 8
    SW_RESTORE = 9
    SW_DEFAULT = 10
End Enum

' ShellExecuteEx mask constants
Public Enum ENUM_SHELLEXECUTEMASK
    SEE_MASK_CLASSKEY = &H3
    SEE_MASK_CLASSNAME = &H1
    SEE_MASK_CONNECTNETDRV = &H80
    SEE_MASK_DOENVSUBST = &H200
    SEE_MASK_FLAG_DDEWAIT = &H100
    SEE_MASK_FLAG_NO_UI = &H400
    SEE_MASK_HOTKEY = &H20
    SEE_MASK_ICON = &H10
    SEE_MASK_IDLIST = &H4
    SEE_MASK_INVOKEIDLIST = &HC
    SEE_MASK_NOCLOSEPROCESS = &H40
End Enum

' Used to halt pipe\shellex processes
Public HaltShellEx As Boolean

' ShellExecuteEx structure
' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/structures/shellexecuteinfo.asp
Private Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hwnd As Long
    lpVerb As String
    lpFile As String
    lpParameters As String
    lpDirectory As String
    nShow As Long
    hInstApp As Long
    
    ' Optional fields
    lpIDList As Long
    lpClass As String
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
End Type

Declare Function TerminateProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Declare Function ShellExecuteEx Lib "Shell32.dll" Alias "ShellExecuteExA" (ByRef ExecInfo As SHELLEXECUTEINFO) As Boolean
Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long


' Execute shell
Public Function Execute(ByRef PathName As String, _
                        ByRef Parameters As String, _
                        ByVal WindowStyle As ENUM_SHELLWINDOWSTYLE, _
                        ByVal WaitForProcess As Boolean, _
                        Optional ByVal PauseWait As Boolean = True, _
                        Optional ByVal ElapsedTimeLimit As Long, _
                        Optional ByVal LaunchElevated As Boolean) As Boolean               'ElapsedTimeLimit = 0 -> no check             [seconds]
     
    Dim Filename As String
    Dim ExecInfo As SHELLEXECUTEINFO
    Dim StartTime As Single
    Dim CurrentTime As Single
    
    On Error GoTo Err_Handling
    
    ' Check if we should add local path
    If (InStr(PathName, "\") = 0) And _
       (InStr(PathName, "/") = 0) And _
       (InStr(PathName, ":") = 0) Then
         
         ' Add local path to PathName
         PathName = App.Path & "\" & PathName
    End If
    
    ' Check existance of PathName
    Filename = Dir(PathName)
    If Filename = "" Then
        If Dir(PathName, vbDirectory) = "" Then
            GoTo Err_Handling
        End If
    End If
    
    ' Fill structure
    With ExecInfo
        .cbSize = Len(ExecInfo)
        .fMask = SEE_MASK_NOCLOSEPROCESS
        .lpFile = PathName
        .lpParameters = Parameters
        .lpDirectory = Left(PathName, Len(PathName) - Len(Filename))
        .nShow = WindowStyle
        If LaunchElevated = True Then ' And m_OpSys.IsVistaOrGreater = True
            .lpVerb = "runas"
        Else
            .lpVerb = "Open"
        End If
    End With
    
    StartTime = Timer
    
    HaltShellEx = False
    Execute = ShellExecuteEx(ExecInfo)
    
    ' Check if we should wait
    If WaitForProcess = True Then
         
        ' Wait for the process to end
        Do While WaitForSingleObject(ExecInfo.hProcess, 10)
            If PauseWait = True Then
                If ElapsedTimeLimit > 0 Then
                    If Timer - StartTime < 0 Then
                        CurrentTime = 24 * 3600 + Timer
                    Else
                        CurrentTime = Timer
                    End If
                    If CurrentTime - StartTime > ElapsedTimeLimit Then
                        HaltShellEx = True
                    End If
                End If
                DoEvents
            End If
            If HaltShellEx = True Then
                TerminateProcess ExecInfo.hProcess, 0
                Execute = False
                Exit Do
            End If
        Loop
    End If
    
    Exit Function
    
Err_Handling:
Execute = False
     
End Function


