Attribute VB_Name = "mod_ShellEx"
'Call ShellEx(0, "conlock.mod", "-uSeR")
'

' Copyright (C) 2003-2006 Jan Vorel
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues

Option Explicit
Option Base 0

'ShellEx_FlagA
'   0 = WaitOnProgramOnly
'  10 = WaitOnProgram
'  30 = WaitOnProgram - No DoEventsEx
' 100 = ShellEx
'     Combines WaitOnProgramSupport Depending on 10/20
' 200 = StdIn/Out/Error support, untested
'( 400 = Manual window pos/size, not yet included )
'1000 = NoNewConsole

Public Const ShellEx_DefaultWaitTime = -1&
Public Const ShellEx_NoWait = 0&



Private Const ShellEx_DefaultWaitTimeX = 5000&

#If (ShellEx_FlagA And &H10&) = &H10& Or ShellEx_FlagA = 0& Then
  Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  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
  #If (ShellEx_FlagA And &H20&) = &H20& Then
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    #End If
  #End If

#If Not (ShellEx_FlagA And &H700&) = 0& Then
  Private Type STARTUPINFO
    cb As Long
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
    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.dll" (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 CreateProcessA Lib "kernel32.dll" (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 String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
  Private Declare Function CreateProcessW Lib "kernel32.dll" (ByVal lpApplicationName As Long, lpCommandLine As Any, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Any, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
  #End If


#If Not (ShellEx_FlagA And &H700&) = 0& Then
  #If (ShellEx_FlagA And &H200&) = &H200& Then
    #If (ShellEx_FlagA And &H10&) = &H10& Then
      Public Function ShellEx(hwnd As Long, ByVal Filename As String, Optional ByVal Parameters As String, Optional ByVal Directory As String, Optional ByVal ShowWindowMode As Long = -1&, Optional ByVal Title As String, Optional ByVal WaitOnProgramInterval = -1&, Optional ByVal hStdInput As Long, Optional ByVal hStdOutput As Long, Optional ByVal hStdError As Long) As Long
      #Else
      Public Function ShellEx(hwnd As Long, ByVal Filename As String, Optional ByVal Parameters As String, Optional ByVal Directory As String, Optional ByVal ShowWindowMode As Long = -1&, Optional ByVal Title As String, Optional ByVal hStdInput As Long, Optional ByVal hStdOutput As Long, Optional ByVal hStdError As Long) As Long
      #End If
    #Else
    #If (ShellEx_FlagA And &H10&) = &H10& Then
      Public Function ShellEx(hwnd As Long, ByVal Filename As String, Optional ByVal Parameters As String, Optional ByVal Directory As String, Optional ByVal ShowWindowMode As Long = -1&, Optional ByVal Title As String, Optional ByVal WaitOnProgramInterval = -1&) As Long
      #Else
      Public Function ShellEx(hwnd As Long, ByVal Filename As String, Optional ByVal Parameters As String, Optional ByVal Directory As String, Optional ByVal ShowWindowMode As Long = -1&, Optional ByVal Title As String) As Long
      #End If
    #End If

    Dim xType1 As STARTUPINFO
    Dim xType2 As PROCESS_INFORMATION
    Dim xLong1 As Long
    
    If Not Filename = "" Then
      With xType1
        .cb = 68& 'Len(xType1)
        If Title = "" Then
          .lpTitle = LocalAllocFromString(Filename)
          Else
          .lpTitle = LocalAllocFromString(Title)
          End If
        If Not ShowWindowMode = -1& Then
          .dwFlags = &H1&
          .wShowWindow = ShowWindowMode
          End If
        #If (ShellEx_FlagA And &H200&) = &H200& Then
          If Not (hStdInput + hStdOutput + hStdError) = 0& Then
            .dwFlags = .dwFlags Or &H100& '.STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
            .hStdInput = hStdInput
            .hStdOutput = hStdOutput
            .hStdError = hStdError
            End If
          #Else
          #End If
        If Trim(Parameters) = "" Then
          Parameters = Filename
          Else
          Parameters = Filename & " " & Parameters
          End If
        End With
      If Directory = "" Then
        Directory = "."
        End If
#If (ShellEx_FlagA And &H1000&) = &H1000& Then
      If IsUnicode Then
        xLong1 = CreateProcessW(0&, ByVal StrPtr(Parameters), 0&, 0&, 1&, 0&, 0&, ByVal StrPtr(Directory), xType1, xType2)
        Else
        xLong1 = CreateProcessA(0&, Parameters, 0&, 0&, 1&, 0&, 0&, Directory, xType1, xType2)
        End If
#Else
      If IsUnicode Then
        xLong1 = CreateProcessW(0&, ByVal StrPtr(Parameters), 0&, 0&, 1&, &H20&, 0&, ByVal StrPtr(Directory), xType1, xType2)
        Else
        xLong1 = CreateProcessA(0&, Parameters, 0&, 0&, 1&, &H20&, 0&, Directory, xType1, xType2)
        End If
#End If
      If Not xType1.lpTitle = 0& Then Call LocalFree(xType1.lpTitle)
      If Not xLong1 = 0& Then
        #If (ShellEx_FlagA And &H10&) = &H10& Then
          ShellEx = xType2.hProcess
          If Not (WaitOnProgramInterval = 0& Or WaitOnProgramInterval < -1&) Then
            Call ShellEx_WaitOnProgram(0&, ShellEx, WaitOnProgramInterval)
            End If
          #End If
        Call CloseHandle(xType2.hProcess)
        Call CloseHandle(xType2.hThread)
        End If
      End If
    End Function
  #End If

#If (ShellEx_FlagA And &H10&) = &H10& Or ShellEx_FlagA = 0& Then
  Public Function ShellEx_WaitOnProgram(ByVal TaskID As Long, ByVal ProcessHandle As Long, Optional ByVal WaitInterval As Long = ShellEx_DefaultWaitTimeX, Optional ByVal OpenProgressAccessMode = &H100000) As Long
    Dim xBool1 As Boolean
    If ProcessHandle = 0& And Not TaskID = 0& Then
      ProcessHandle = OpenProcess(OpenProgressAccessMode, False, TaskID)
      xBool1 = True
      End If
    If Not ProcessHandle = 0& Then
      If WaitInterval = -1& Then WaitInterval = ShellEx_DefaultWaitTimeX
      #If (ShellEx_FlagA And &H20&) = &H20& Then
        Call Sleep(WaitInterval)
        #Else
        DoEventsEx 1000&
        #End If
      Do While (WaitForSingleObject(ProcessHandle, 100&) = 258&)
        DoEventsEx WaitInterval
        Loop
      If xBool1 Then Call CloseHandle(ProcessHandle)
      End If
    End Function
  #End If

