Private Type LARGE_INTEGER
    LowPart As Long
    HighPart As Long
End Type
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 Sub Form_Load()
    'KPD-Team 2001
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim T As Long, liFrequency As LARGE_INTEGER, liStart As LARGE_INTEGER, liStop As LARGE_INTEGER
    Dim cuFrequency As Currency, cuStart As Currency, cuStop As Currency
    'Retrieve the frequency of the performance counter
    If QueryPerformanceFrequency(liFrequency) = 0 Then
        MsgBox "Your hardware doesn't support a high-resolution performance counter!", vbInformation
    Else
        'convert the large integer to currency
        cuFrequency = LargeIntToCurrency(liFrequency)
        'retrieve tick count
        QueryPerformanceCounter liStart
        'do something
        For T = 0 To 100000
            DoEvents
        Next T
        'retrieve tick count
        QueryPerformanceCounter liStop
        'convert large integers to currency's
        cuStart = LargeIntToCurrency(liStart)
        cuStop = LargeIntToCurrency(liStop)
        'calculate how many seconds passed, and show the result
        MsgBox "Time: " + CStr((cuStop - cuStart) / cuFrequency) + " seconds"
    End If
End Sub
Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency
    'copy 8 bytes from the large integer to an ampty currency
    CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
    'adjust it
    LargeIntToCurrency = LargeIntToCurrency * 10000
End Function

Close this window