Attribute VB_Name = "mdlBench"
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Private Const ABOVE_NORMAL_PRIORITY_CLASS = &H8000&
Private Const BELOW_NORMAL_PRIORITY_CLASS = &H4000&
Private Const HIGH_PRIORITY_CLASS = &H80&
Private Const IDLE_PRIORITY_CLASS = &H40&
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const REALTIME_PRIORITY_CLASS = &H100&
Declare Function GetTickCount Lib "kernel32" () As Long

Sub Main()
    Dim tmpI As Integer
    Dim tmpL As Long
    Dim Result As String
    Dim I As Long
    Dim C As Long
    Dim B As String
    SetMyPriority REALTIME_PRIORITY_CLASS
    C = 0
    I = GetTickCount + 1000
    Do Until GetTickCount >= I
        For tmpL = 0 To 500
        Next
        C = C + 1
    Loop
    Result = Format$(C, "###,###") & " loops per second (Long)" & vbCrLf
    C = 0
    I = GetTickCount + 1000
    Do Until GetTickCount >= I
        For tmpI = 0 To 500
        Next
        C = C + 1
    Loop
    Result = Result & Format$(C, "###,###") & " loops per second (Integer)"
    MsgBox Result
End Sub

Private Function SetMyPriority(Priority As Long) As Boolean
    Dim hProcess As Long
    Dim nResult As Long
    hProcess = GetCurrentProcess
    nResult = SetPriorityClass(hProcess, Priority)
    If nResult = 0 Then
        SetMyPriority = False
    Else
        SetMyPriority = True
    End If
End Function
