Calculate timing 23-May-2012

				
'**************************************
' Name: Calculate timing23-May-2012
' Description:Basically, this is just one more way of calculating and displaying how much time a process took before finishing. This will check for a hi-performance timer and if none is found then uses the API GetTickCount.
' By: Kenaso
'
'This code is copyrighted and has' limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=74366&lngWId=1'for details.'**************************************

' ***************************************************************************
' API Declares
' ***************************************************************************
 ' Retrieves the frequency of the high-resolution performance counter,
 ' if one exists. The frequency cannot change while the system is running.
 ' If the function fails, the return value is zero.
 Private Declare Function QueryPerformanceFrequency Lib "kernel32" _
 (curFrequency As Currency) As Long
 
 ' The QueryPerformanceCounter function retrieves the current value of the
 ' high-resolution performance counter.
 Private Declare Function QueryPerformanceCounter Lib "kernel32" _
 (curCounter As Currency) As Boolean
 ' This is a rough translation of the GetTickCount API. The
 ' tick count of a PC is only valid for the first 49.7 days
 ' since the last reboot. When you capture the tick count,
 ' you are capturing the total number of milliseconds elapsed
 ' since the last reboot. The elapsed time is stored as a
 ' DWORD value. Therefore, the time will wrap around to zero
 ' if the system is run continuously for 49.7 days.
 Private Declare Function GetTickCount Lib "kernel32" () As Long
 
' ***************************************************************************
' Module Variables
'
'+-------------- Module level designator
'| +----------- Data type (Currency)
'| | |----- Variable subname
'- --- ---------
' Naming standard:m cur Frequency
' Variable name: mcurFrequency
'
' ***************************************************************************
 Private mcurFrequency As Currency' High performance Frequency
 
-----------------------------------------------------
Example:
 ' Somewhere in the beginning of your code, attempt to capture 
 ' the freequency of the hi-performance timer if it is available.
 QueryPerformanceFrequency mcurFrequency
 ' Get starting time
 If mcurFrequency > 0 Then
 QueryPerformanceCounter curStart' Hi-performance timer available
 Else
 curStart = CCur(GetTickCount) ' No hi-performance timer
 End If
... Do something here ...
 ' Get ending time
 If mcurFrequency > 0 Then
 QueryPerformanceCounter curEnd ' Hi-performance timer available
 Else
 curEnd = CCur(GetTickCount) ' No hi-performance timer
 End If
 strElapsedTime = ElapsedTime(curStart, curEnd)' Calc elapsed time
-----------------------------------------------------
' ***************************************************************************
' Routine:ElapsedTime
'
' Description:Calculates and formats elapsed time
'
' Parameters:curMilliseconds - Time in milliseconds
'
' Returns:Formatted output
'Ex: 12:34:56.7890' Hi-performance timer available
' 12:34:56.789' No hi-performance timer available
'
' ===========================================================================
'DATE NAME / eMAIL
' DESCRIPTION
' ----------- --------------------------------------------------------------
' 19-May-2012 Kenneth Ives kenaso@tx.rr.com
' Wrote routine
' ***************************************************************************
Private Function ElapsedTime(ByVal curStart As Currency, _
 ByVal curEnd As Currency) As String
Dim lngDays As Long
Dim lngHoursAs Long
Dim lngMinutes As Long
Dim lngSeconds As Long
Dim curFrequencyAs Currency
Dim curThousandsAs Currency
Dim curMilliseconds As Currency
Dim strThousandsAs String
ElapsedTime = vbNullString
strThousands = vbNullString
' Check for Hi-performance timer
If mcurFrequency > 0 Then
' Calculate number of milliseconds
curMilliseconds = ((((curEnd - curStart) * 10000) / mcurFrequency) / 10000)
lngSeconds = CLng(Fix(curMilliseconds)) ' Convert to whole seconds
curThousands = (curMilliseconds - lngSeconds)' Capture any remaining milliseconds
' Convert thousands to string format
If curThousands > 0@ Then
strThousands = CStr(curThousands)
strThousands = Mid$(strThousands, InStr(1, strThousands, "."))
Else
strThousands = ".0000"
End If
Else
' No hi-performance timer available
curMilliseconds = (curEnd - curStart)' Calculate milliseconds
lngSeconds = CLng(Int(curMilliseconds / 1000)) ' Convert to whole seconds
curThousands = (curMilliseconds - (lngSeconds * 1000)) ' Capture any remaining milliseconds
strThousands = "." & Format$(curThousands, "000")' Convert thousands to string format
End If
' 86400 seconds in one day
' 3600 seconds in one hour
'60 seconds in one minute
lngDays = CLng(Int(lngSeconds / 86400))' Calc number of days
lngSeconds = lngSeconds - (lngDays * 86400)' Recalc number of seconds
lngHours = CLng(Int(lngSeconds / 3600))' Calc number of hours
lngSeconds = lngSeconds - (lngHours * 3600)' Recalc number of seconds
lngMinutes = CLng(Int(lngSeconds / 60))' Calc number of minutes
lngSeconds = lngSeconds - (lngMinutes * 60)' Recalc number of seconds
' Format number of days, if any
If lngDays > 0 Then
ElapsedTime = Format$(lngDays, "0") & " day(s) "
End If
' Format and return elapsed time
ElapsedTime = ElapsedTime & _
 Format$(TimeSerial(lngHours, lngMinutes, lngSeconds), "hh:nn:ss") & _
 strThousands
 
End Function