Простейший анализатор производительности системы (кода программы)

Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
 
    Private Type LARGE_INTEGER
        LowPart As Long
        HighPart As Long
    End Type
 
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
 
Dim Shadow   As clsShadow
 
Private Sub Command1_Click()
    
    Dim intK            As Integer
    Dim dblT               As Double
    Dim liFrequency     As LARGE_INTEGER
    Dim liStart         As LARGE_INTEGER, liStop As LARGE_INTEGER
    Dim cuFrequency     As Currency
    Dim cuStart         As Currency
    Dim cuStop          As Currency
    Dim dblTd           As Double
    Dim dblTmax(1000)      As Double
    Dim dblSum             As Double
    Dim intFreeNoom     As Integer
    
    
    intFreeNoom = FreeFile
    Open App.Path & "\PerfCount.log" For Append As #intFreeNoom  ' лог файл
      
      Print #intFreeNoom, ""
      Print #intFreeNoom, "Date - "; Date
      Print #intFreeNoom, "Time - "; Time
      Print #intFreeNoom, ""
      
    
    If QueryPerformanceFrequency(liFrequency) <> 0 Then
        List1.Clear
        List1.AddItem ""
        List1.AddItem "Please do not touch the mouse and "
        List1.AddItem "keyboard while the test begin!"
        List1.AddItem ""
        List1.AddItem "============== Test Begin ================"
        List1.AddItem ""
        
        Print #intFreeNoom, ""
        Print #intFreeNoom, "============== Test Begin ================"
        Print #intFreeNoom, ""
        
        For intK = 0 To Val(Text2)
          cuFrequency = LargeIntToCurrency(liFrequency)
          QueryPerformanceCounter liStart
                    
                    '
                    ' Любое арифмитеческое выражение или код вашей программы
                    '
                        For dblT = 0 To Val(Text1)
                                    dblTd = ((Sin(dblT) ^ 2) * 1.25666 + Cos((dblT / 1.2563 / Tan(1.25688))) + _
                                    (Sin(dblT) ^ 2) * 1.25666 + Cos((dblT / 1.2563 / Tan(1.25688))) + (Sin(dblT) ^ 2) * _
                                    1.25666 + Cos((dblT / 1.2563 / Tan(1.25688))) + (Sin(dblT) ^ 2) * 1.25666 + _
                                    Cos((dblT / 1.2563 / Tan(1.25688))) + (Sin(dblT) ^ 2) * 1.25666 + Cos((dblT / 1.2563 / Tan(1.25688))) + _
                                    (Sin(dblT) ^ 2) * 1.25666 + Cos((dblT / 1.2563 / Tan(1.25688)))) / 12.1212154545455 + Tan(dblT) + _
                                    Log(5.25665 * 56.25665)
                            DoEvents
                        Next
                    
                    '
                    ' Любое арифмитеческое выражение или код вашей программы
                    '
                    
            QueryPerformanceCounter liStop
            cuStart = LargeIntToCurrency(liStart)
            cuStop = LargeIntToCurrency(liStop)
            List1.AddItem "      Count " & Format(intK + 1, "0#") & "  Time: " & Format((((cuStop - cuStart) / cuFrequency)), "0.000") & " seconds"
            Print #intFreeNoom, "      Count " & Format(intK + 1, "0#") & "  Time: " & Format((((cuStop - cuStart) / cuFrequency)), "0.000") & " seconds"
            dblTmax(intK) = CStr((cuStop - cuStart) / cuFrequency)
       Next
       
       
       For intK = 0 To Val(Text2)
            dblSum = dblSum + dblTmax(intK)
       Next
       
       List1.AddItem ""
       List1.AddItem "=============== Test End =================="
       List1.AddItem ""
       
       List1.AddItem "       Averge Time: " + Format(dblSum / (Val(Text2) + 1), "0.0000") & " seconds"
       List1.AddItem ""
       List1.AddItem " my CoreI5@4200MHz: " & "1.072 sec.   P-Code"
       List1.AddItem " my CoreI5@4200MHz: " & "0.902 sec. FastCode"
       
       Print #intFreeNoom, ""
       Print #intFreeNoom, "=============== Test End =================="
       Print #intFreeNoom, ""
       Print #intFreeNoom, "       Averge Time: " + Format(dblSum / (Val(Text2) + 1), "0.0000") & " seconds"
     Close #intFreeNoom
       
       
    End If
End Sub
 
Private Sub Command2_Click()
        Set Shadow = Nothing
        Unload frmPerfomance
        End
End Sub
 
Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency
        CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
        LargeIntToCurrency = LargeIntToCurrency * 10000
End Function
 
Private Sub Form_Load()
    
        '
        ' установка тени от формы
        '
        
        ' Shadow.Depth - размер
        ' Shadow.Transparency  - прозрачность
        '
        
            Set Shadow = New clsShadow
            Call Shadow.Shadow(Me)
            Shadow.Depth = 12
            Shadow.Transparency = 110
 
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        '
        ' перетаскивание за форму
        '
        ReleaseCapture
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub
 
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        ReleaseCapture
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub

Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
 
Private Sub Form_Load()
Dim cuFrequency     As Currency
Dim cuStart         As Currency
Dim cuStop          As Currency
Dim sngStart As Single, sngStop As Single
Dim dblT As Double, dblTd As Double
If QueryPerformanceFrequency(cuFrequency) = 0 Then
  MsgBox "Счетчик не работает", vbCritical
Else
  sngStart = Timer
  QueryPerformanceCounter cuStart
  For dblT = 1 To 50000
              dblTd = ((Sin(dblT) ^ 2) * 1.25666 + Cos((dblT / 1.2563 / Tan(1.25688))) + _
              (Sin(dblT) ^ 2) * 1.25666 + Cos((dblT / 1.2563 / Tan(1.25688))) + (Sin(dblT) ^ 2) * _
              1.25666 + Cos((dblT / 1.2563 / Tan(1.25688))) + (Sin(dblT) ^ 2) * 1.25666 + _
              Cos((dblT / 1.2563 / Tan(1.25688))) + (Sin(dblT) ^ 2) * 1.25666 + Cos((dblT / 1.2563 / Tan(1.25688))) + _
              (Sin(dblT) ^ 2) * 1.25666 + Cos((dblT / 1.2563 / Tan(1.25688)))) / 12.1212154545455 + Tan(dblT) + _
              Log(5.25665 * 56.25665)
  Next
  QueryPerformanceCounter cuStop
  sngStop = Timer
  MsgBox "Время по счетчику " & (cuStop - cuStart) / cuFrequency & vbLf & _
    "Время по таймеру " & sngStop - sngStart
End If
End
End Sub