Projects

Find all our projects in development below.
All source code is GNU General Public License (GPL)

QuickQuery Half-Life Edition

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

Back to file list


Back to project page