Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing QuickQuery HL Edition/RunProgramMod.bas (3.90 KB)
Attribute VB_Name = "RunProgramMod"
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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 OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const IDLE_PRIORITY_CLASS = &H40
Private Const HIGH_PRIORITY_CLASS = &H80
Private Const REALTIME_PRIORITY_CLASS = &H100
Private Const BELOW_NORMAL_PRIORITY_CLASS = &H4000
Private Const ABOVE_NORMAL_PRIORITY_CLASS = &H8000
Private Const PROCESS_TERMINATE = &H1
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 Const STARTF_USESHOWWINDOW = &H1
Public Enum ShowWindowAPIContants
iSW_NORMAL = 0
iSW_MINIMIZE = 1
iSW_MAXIMIZE = 2
End Enum
Private Const SW_NORMAL = 1
Private Const SW_MAXIMIZE = 3
Private Const SW_MINIMIZE = 6
Public Function EndAdditionalProgram(PID As Long) As Long
Dim hProcess As Long
Dim lExitCode As Long
hProcess = OpenProcess(PROCESS_TERMINATE, 0&, PID)
If hProcess Then EndAdditionalProgram = TerminateProcess(hProcess, lExitCode)
CloseHandle hProcess
End Function
Public Function RunAdditionalProgram(Location As String, Optional CmdLine As String = vbNullString, Optional PriorityClass As Integer = 2, Optional WorkingDir As String, Optional StartupMode As ShowWindowAPIContants = iSW_NORMAL) As Long
On Error Resume Next
Dim typStartUpInfo As STARTUPINFO
Dim typProcessInfo As PROCESS_INFORMATION
Dim iRunMode As Long
Dim PPriority As Long
Dim strWorkingDir As String
Select Case StartupMode
Case iSW_MINIMIZE
iRunMode = SW_MINIMIZE
Case iSW_MAXIMIZE
iRunMode = SW_MAXIMIZE
Case Else
iRunMode = SW_NORMAL
End Select
With typStartUpInfo
.cb = Len(typStartUpInfo)
.dwFlags = STARTF_USESHOWWINDOW
.wShowWindow = iRunMode
.lpReserved = vbNullString
.lpDesktop = vbNullString
.lpTitle = vbNullString
End With
Select Case PriorityClass
Case 0
PPriority = IDLE_PRIORITY_CLASS
Case 1
PPriority = BELOW_NORMAL_PRIORITY_CLASS
Case 3
PPriority = ABOVE_NORMAL_PRIORITY_CLASS
Case 4
PPriority = HIGH_PRIORITY_CLASS
Case 5
PPriority = REALTIME_PRIORITY_CLASS
Case Else
PPriority = NORMAL_PRIORITY_CLASS
End Select
strWorkingDir = WorkingDir
If strWorkingDir = "" Then strWorkingDir = Left(Location, InStrRev(Location, "\") - 1)
CreateProcess Location, " " + CmdLine, 0, 0, True, PPriority, ByVal 0&, strWorkingDir, typStartUpInfo, typProcessInfo
RunAdditionalProgram = typProcessInfo.dwProcessId
CloseHandle typProcessInfo.hThread
CloseHandle typProcessInfo.hProcess
End Function
Download QuickQuery HL Edition/RunProgramMod.bas