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&
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub Main()
    Dim I As Long
    Dim C As Long
    Dim ResultText As String
    Dim String1 As String
    Dim String2 As String
    String1 = "thisissmallButGoodstringforthistesT"
    String2 = "thisissmallButGoodstringforthistesT"
    SetMyPriority REALTIME_PRIORITY_CLASS
    C = 0
    I = GetTickCount + 1000
    Do Until GetTickCount >= I
        If String1 = String2 Then
        End If
        C = C + 1
    Loop
    ResultText = Format$(C, "###,###") & " operations per second (string1 = string2)" & vbCrLf
    C = 0
    I = GetTickCount + 1000
    Do Until GetTickCount >= I
        If StrComp(String1, String2, vbTextCompare) = 0 Then
        End If
        C = C + 1
    Loop
    ResultText = ResultText & Format$(C, "###,###") & " operations per second (StrComp)" & vbCrLf
    C = 0
    I = GetTickCount + 1000
    Do Until GetTickCount >= I
        If StringComp(String1, String2) Then
        End If
        C = C + 1
    Loop
    ResultText = ResultText & Format$(C, "###,###") & " operations per second (my string comparison, StringComp)"
    MsgBox ResultText
End Sub

'Very Fast String Comparison Function
'                    by Steven Noonan
Private Function StringComp(ByRef sStringOne As String, ByRef sStringTwo As String) As Boolean
    If LenB(sStringOne) <> LenB(sStringTwo) Then Exit Function
    StringComp = StrComp(sStringOne, sStringTwo, vbTextCompare) = 0
End Function

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

