Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing QuickQuery HL Edition/RunMod.bas (3.53 KB)
Attribute VB_Name = "RunMod"
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 WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds 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 INFINITE = &HFFFFFFFF
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
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 m_PID As Long
Public Function RunProgram(Location As String, Optional CmdLine As String = vbNullString, Optional PriorityClass As Integer = 2) As Long
On Error Resume Next
Dim typStartUpInfo As STARTUPINFO
Dim typProcessInfo As PROCESS_INFORMATION
Dim PPriority As Long
With typStartUpInfo
.cb = Len(typStartUpInfo)
.dwFlags = 0
.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
m_PID = 0
RunProgram = CreateProcess(Location, " " + CmdLine, 0, 0, True, PPriority, ByVal 0&, Left(Location, InStrRev(Location, "\") - 1), typStartUpInfo, typProcessInfo)
CloseHandle typProcessInfo.hThread
CloseHandle typProcessInfo.hProcess
If RunProgram And Optn_WaitForReturn = 1 Then
m_PID = typProcessInfo.dwProcessId
bIsLaunched = True
TerminateWaitForm.Show 1, LaunchForm
End If
End Function
Public Sub ThreadWaitForProgram()
Dim hProcess As Long
If m_PID = 0 Then Exit Sub
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, m_PID)
WaitForInputIdle hProcess, INFINITE
WaitForSingleObject hProcess, INFINITE
CloseHandle hProcess
m_PID = 0
TerminateWaitForm.PostWaitTimer.Enabled = True
End Sub
Download QuickQuery HL Edition/RunMod.bas