Option Explicit
Private Type LARGE_INTEGER
LowPart As Long
HighPart As Long
End Type

Private Declare Function QueryPerformanceFrequency Lib _
"kernel32.dll" (lpFrequency As LARGE_INTEGER) As Long

Private Declare Function QueryPerformanceCounter Lib _
"kernel32.dll" (lpPerformanceCount As LARGE_INTEGER) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias _
"RtlMoveMemory" (Destination As Any, Source _
As Any, ByVal Length As Long)
' Den här funktionen omvandlar LARGE_INTEGER strukture till
' VB's 64-bit Currency Data Type. För mer info
' http://www.vbapi.com/articles/64bit/index.html <../../articles/64bit/index.html>.
Private Function LI2Curr(li As LARGE_INTEGER) As Currency
Dim temp As Currency
CopyMemory temp, li, 8
LI2Curr = temp * 10000
End Function
' *** Formens Kod ***
Private Sub Command1_Click()
Dim freq As Currency ' high-performance timer frekvens
Dim count1 As Currency ' timer inläsning före beräkning
Dim count2 As Currency ' timer inläsning efter beräkning
Dim buffer1 As LARGE_INTEGER ' data input buffer för...
Dim buffer2 As LARGE_INTEGER ' ...Timer funktion
Dim tid As String
Dim c As Long ' räknare till Forsatsen
Dim result As Double ' resultat kvadratrot
Dim retval As Long ' allmän retur variabel
' Hämta frekvensen för high-performance Timern
retval = QueryPerformanceFrequency(buffer1)
If retval = 0 Then
MsgBox "Systemet har ingen högupplösnings Timer"
Exit Sub
End If
freq = LI2Curr(buffer1) ' Frekvens i Hz
'Ta reda på tiden för 100000 uträkningar kvadratrot
'Startvärde QueryPerformanceCounter
retval = QueryPerformanceCounter(buffer1)
For c = 1 To 100000
result = Sqr(c)
Next 'c
'Slutvärde efter 100000 uträkningar
retval = QueryPerformanceCounter(buffer2)
' Beräkna tiden
count1 = LI2Curr(buffer1)
count2 = LI2Curr(buffer2)
'Sekunder med 9 decimaler
tid = Format$((count2 - count1) / freq, "0.000000000")
MsgBox "Uträkningen tog " & tid & _
" sekunder." & vbCrLf & vbCrLf & _
"Antal Query Performance Count " & _
count2 - count1 & vbCrLf & vbCrLf & _
"Frekvens :" & freq & " Hz"
End Sub