1 Option Explicit
2
3 Private Declare Function GetTickCount Lib "kernel32" () As Long
4
5 Private myTimer As Long
6 Private StartTime As Date
7 Private EndTime As Date
8
9 Public ProcName As String
10 Private Sub Class_Initialize()
11 myTimer = GetTickCount 'Инициализация счётчика времени работы
12 StartTime = Now 'Время начала измерений
13 End Sub
14
15 Private Sub Class_Terminate()
16 EndTime = Now 'Время конца измерений
17 MsgBox "Результаты замера производительности для """ & ProcName & """." & vbCr & "Начало измерений: " & FormatDateTime(StartTime, vbShortDate) & " " & FormatDateTime(StartTime, vbLongTime) & vbCr & _
18 "Конец измерений: " & FormatDateTime(EndTime, vbShortDate) & " " & FormatDateTime(EndTime, vbLongTime) & vbCr & _
19 "Время работы: " & (GetTickCount - myTimer) / 1000 & " сек.", vbOKOnly + vbInformation, "Результаты измерения производительности"
20 End Sub
2
3 Private Declare Function GetTickCount Lib "kernel32" () As Long
4
5 Private myTimer As Long
6 Private StartTime As Date
7 Private EndTime As Date
8
9 Public ProcName As String
10 Private Sub Class_Initialize()
11 myTimer = GetTickCount 'Инициализация счётчика времени работы
12 StartTime = Now 'Время начала измерений
13 End Sub
14
15 Private Sub Class_Terminate()
16 EndTime = Now 'Время конца измерений
17 MsgBox "Результаты замера производительности для """ & ProcName & """." & vbCr & "Начало измерений: " & FormatDateTime(StartTime, vbShortDate) & " " & FormatDateTime(StartTime, vbLongTime) & vbCr & _
18 "Конец измерений: " & FormatDateTime(EndTime, vbShortDate) & " " & FormatDateTime(EndTime, vbLongTime) & vbCr & _
19 "Время работы: " & (GetTickCount - myTimer) / 1000 & " сек.", vbOKOnly + vbInformation, "Результаты измерения производительности"
20 End Sub
Использовать этот класс очень просто. В модуле нужно объявить экземпляр класса, перед началом измеряемого процесса класс нужно инициализировать и задать имя процедуры или процесса. По окончании — уничтожить экземпляр класса.
1 Sub test()
2 Dim i As Long
3 Dim pm As PerformanceMeter
4
5 Set pm = New PerformanceMeter
6 pm.ProcName = "test"
7 For i = 0 To 10000000
8 Next i
9 Set pm = Nothing
10 End Sub
2 Dim i As Long
3 Dim pm As PerformanceMeter
4
5 Set pm = New PerformanceMeter
6 pm.ProcName = "test"
7 For i = 0 To 10000000
8 Next i
9 Set pm = Nothing
10 End Sub