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

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