dcsimg
Login | Register   
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX

By submitting your information, you agree that devx.com may send you DevX offers via email, phone and text message, as well as email offers about other products and services that DevX believes may be of interest to you. DevX will process your information in accordance with the Quinstreet Privacy Policy.


Tip of the Day
Language: VB4/32,VB5,VB6
Expertise: Intermediate
Jan 6, 2001

WEBINAR:

On-Demand

Application Security Testing: An Integral Part of DevOps


PerformanceTimer - A class module for high-resolution time measurement

'-------------------------------------------
' PerformanceTimer class module
'-------------------------------------------

' Use this class to profile your code and any other operation
' typically with a precision greater than 1 millionth of a second
'
' As soon as you create an object, the timer starts
' but you can also start it explicitly with StartTimer
' Stop the timer and retrieve timing with StopTimer, or
' get the timing without stopping the timer with ElapsedTime
'
' The TotalTime property returns the number of seconds the
' timer has been active, so you can use it to sum up partial
' timings, after swithing the timer on and off
' The FormatTime is similar to elapsed time, but returns
' the time as a formatted string with desired precision
'
' Example:
'         Dim pc As New PerformanceCounter
'         pc.StartTimer
'         ' ...
'         ' put here the code you want to benchmark
'         ' ...
'         ' print elapsed time, but don't stop the timer
'         Debug.Print pc.ElapsedTime
'         ' ...
'         ' so something else here
'         ' ...
'         ' print elapsed time and stop the timer
'         Debug.Print pc.StopTimer
'         ' ...
'         ' prepare another benchmark here
'         ' ...
'         ' start the benchmark, without resetting total time
'         pc.StartTimer
'         ' ...
'         ' put here the code you want to benchmark
'         ' ...
'         ' print elapsed as a formatted string
'         Debug.Print pc.FormatTime("Second benchmark ### secs.", 4)
'         ' print total time
'         Debug.Print pc.TotalTime
'

Option Explicit

Private Declare Function QueryPerformanceFrequencyAny Lib "kernel32" Alias _
    "QueryPerformanceFrequency" (lpFrequency As Any) As Long
Private Declare Function QueryPerformanceCounterAny Lib "kernel32" Alias _
    "QueryPerformanceCounter" (lpPerformanceCount As Any) As Long

' the frequency for this computer
Dim frequency As Currency
Dim startTime As Currency
Dim endTime As Currency
Dim totTime As Currency

' Start the timer
'
' if argument is True, it also resets the
' internal total time counter

Sub StartTimer(Optional ByVal ResetTotalTime As Boolean)
    ' get the current value of the counter
    QueryPerformanceCounterAny startTime
    ' reset total time counter if requested
    If ResetTotalTime Then totTime = 0
End Sub

' stop the timer
'
' returns the time elapsed since StartTimer

Function StopTimer() As Double
    ' get the elapsed time
    StopTimer = ElapsedTime
    ' update the total time counter
    totTime = totTime + (endTime - startTime)
    ' reset starting time
    startTime = 0
End Function

' return the elapsed time in seconds since StartTimer
' without stopping the timer

Property Get ElapsedTime() As Double
    ' exit if StartTimer hasn't been called since
    ' the previous call to StopTimer
    If startTime = 0 Then Exit Property
    
    ' get the current value of the counter
    QueryPerformanceCounterAny endTime
    ' return the elapsed time in seconds
    ElapsedTime = (endTime - startTime) / frequency
End Property

' return the total time in seconds

Property Get TotalTime() As Double
    If startTime = 0 Then
        ' StopTimer has been called
        ' so totTime is correctly updated
        TotalTime = totTime / frequency
    Else
        TotalTime = (totTime + (endTime - startTime)) / frequency
    End If
End Property

' return a time value as a formatted string
' if second argument is omitted, it uses ElapsedTime
'
' return it as a formatted string with
' specified number of decimal - use ### in the string
' as a placeholder for the elapsed time
'   e.g.  Print GetTimeMsg("Elapsed ### secs.", , 4)
'
' NOTE: this function is slightly less precise than
'       GetTime, because arguments are passed

Property Get FormatTime(msg As String, Optional seconds As Double = -1, _
    Optional ByVal decDigits As Integer = 7) As String
    ' get the elapsed time if not passed as an argument
    If seconds < 0 Then seconds = ElapsedTime()
    ' build the result string
    FormatTime = Replace(msg, "###", CStr(Round(seconds, decDigits)))
End Property

' return the timer precision in seconds

Property Get Precision() As Double
    ' frequency must be scaled up by 10E4
    Precision = 1 / (frequency * 10000#)
End Property

' evaluate the frequency once and for all
' when this object is created

Private Sub Class_Initialize()
    ' raise error if API functions aren't supported
    If QueryPerformanceFrequencyAny(frequency) = 0 Then
        Err.Raise 1001, , "This system doesn't support high-res timing"
    End If
    ' get start time as well
    StartTimer
End Sub

Francesco Balena
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
×
We have made updates to our Privacy Policy to reflect the implementation of the General Data Protection Regulation.
Thanks for your registration, follow us on our social networks to keep up-to-date