Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0698: Kleine Zeitspannen mit der CPU-Clock messen

 von 

Beschreibung 

Ab dem Pentium beinhalten alle x86-CPUs einen internen Taktzähler. Dieser wird hier genutzt, um kleine Zeitspannen zu messen.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

QueryPerformanceCounter (API_PCounter), QueryPerformanceFrequency (API_PFrequency), Sleep (API_Sleep), CallWindowProcA (ASM_cdLong)

Download:

Download des Beispielprojektes [11,15 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'-------- Anfang Modul "cpuClock" alias cpuClock.bas --------


'-------------------------------------------------------------
' CPU-clock zum Messen kleiner Zeiten nutzen
' (benötigt einen Pentium-Prozessor!)
'
' (softKUS) - X/2003
'-------------------------------------------------------------

Option Explicit

Dim cur_txt        As String
Public clk_sec     As Currency
Public clk_dmy     As Currency
Public clk_frq     As Currency
Public clk_run(19) As Currency


' Aufruf von asm-Funktionen (Deklaration für Longs)
Private Declare Function ASM_cdLong _
    Lib "user32" _
    Alias "CallWindowProcA" _
    (ByRef adr As Long, _
     ByVal PA1 As Long, _
     ByVal PA2 As Long, _
     ByVal PA3 As Long, _
     ByVal PA4 As Long) As Long

Private Declare Function API_PCounter _
    Lib "kernel32" _
    Alias "QueryPerformanceCounter" _
    (lpPerformanceCount As Currency) As Long
        
Private Declare Function API_PFrequency _
    Lib "kernel32" _
    Alias "QueryPerformanceFrequency" _
    (lpFrequency As Currency) As Long

Private Declare Sub API_Sleep _
    Lib "kernel32" Alias "Sleep" _
   (ByVal dwMilliSeconds As Long)

' clkDELAY      Sleep-Funktion
'
' AUFRUF:       clkDELAY(D1:Delay, [N1:Interval], [@C1:lpcDelay], [@C2:lpcWait])
'
' EIN:          dbl:D1  Wartezeit in sec
'               lng:N1  =0: entspricht clkWAIT
'                       >0: periodischer Aufruf von sleep/DoEvents
'
' AUS:          cur:C1  Platzhalter für loop-counter
'               cur:C2  Platzhalter für clkWAIT-loop-counter
'
' RÜCKGABE:     cur     Absolut verstrichene Zeit
'
Function clkDELAY( _
    Delay As Double, _
    Optional Interval As Long = 5, _
    Optional lpcDelay As Currency, _
    Optional lpcWait As Currency) As Double

    Dim cACT    As Currency
    Dim cRUN    As Currency
    Dim cEND    As Currency
    Dim cTMP    As Currency
    Dim cCLK(3) As Currency
    Dim dbl     As Double
    
    clkINI
    clkGET cCLK
    
    lpcDelay = 0
    lpcWait = 0
    
    If Interval = 0 Then
    ElseIf (Delay * clk_frq) > Interval Then
        API_PCounter cRUN
        cEND = cRUN + Delay * clk_frq
        cTMP = cEND - 0.02 * clk_frq
        API_PCounter cACT
        
        Do While cACT < cTMP
            lpcDelay = lpcDelay + 1
            API_Sleep Interval
            DoEvents
            API_PCounter cACT
        Loop
    End If
    
    clkGET cCLK, 2
    dbl = Delay - (cCLK(2) - cCLK(0) + clk_dmy) / clk_sec
    If dbl > 0 Then clkWAIT dbl, lpcWait
    
    clkGET cCLK
    clkDELAY = cCLK(1) / clk_sec
End Function

' clkFMT        Formatieren von Zeispannen
'
' AUFRUF:       clkFMT(cur, [cnt])
'
' EIN:          cur:cur Zu formatierender Wert
'               lng:cnt Anzahl Nachkommastellen (Vorgabe=2)
'
' RÜCKGABE:     chr     Formatierter Text
'
Function clkFMT( _
    cur As Currency, _
    Optional cnt As Long = 2) As String
    
    Dim Sec As Double
    Dim txt As String
    
    txt = "0." & String(cnt, "0")
    
    If cur < 0 Then
        clkFMT = cur_txt
        
    ElseIf cur <> 0 Then
        If clk_sec Then Sec = cur / clk_sec
        Select Case Log(Sec) / Log(10)
        Case Is > 1
            clkFMT = Format(Sec / 60, txt) & " m"
            
        Case Is > -1
            clkFMT = Format(Sec, txt) & " s"
            
        Case Is > -4
            clkFMT = Format(Sec * 1000, txt) & " ms"
            
        Case Else
            clkFMT = Format(Sec * 1000000, txt) & " µs"
        End Select
    End If
End Function

' clkGET        Einlesen des CPU-internen Taktzählers
'
' AUFRUF:       clkGET(cur(), [NR])
'
' EIN:          cur:cur()   Array von mind. 2 Currency-Werten
'               lng:NR      Zeiger auf cur()-Element (Vorgabe=0)
'
' RÜCKGABE:     cur(NR)     Aktueller CPU-Taktzähler
'               cur(NR+1)   Differenz zw. aktuellem cur(NR) und
'                           cur(NR) beim Funktionsaufruf
'
' HINWEIS:      Um Zeiten zu messen, sollte clkGET einmal zur Initiali-
'               sierung aufgerufen werden (setzt cur(NR)) und ein weiteres
'               mal zur Berechnung der Zeitspanne (setzt cur(NR+1))
'
Function clkGET( _
    cur() As Currency, _
    Optional NR As Long) As Currency
    
    Static asm(9) As Long

    If asm(0) = 0 Then
        asm(0) = &H4C8B310F:  asm(1) = &H31FF0424
        asm(2) = &H890471FF:  asm(3) = &H4518901
        asm(4) = &H424442B:   asm(5) = &H8924141B
        asm(6) = &H51890841:  asm(7) = &HF95A580C
        asm(8) = &H10C2C01B:  asm(9) = &H0
    End If
    
    ' *****************************************************
    
    On Error Resume Next ' Fehler: ungültiges Array abfangen
    
    If UBound(cur) >= NR + 1 Then
        ASM_cdLong asm(0), VarPtr(cur(NR)), 0, 0, 0
        clkGET = cur(NR + 1)
    End If
End Function

' clkINI        Initialisieren
'
' AUFRUF:       clkINI([vl])
'
' EIN:          dbl:vl  CheckRate (Vorgabe = 0.5)
'                       Erklärung s. unten
'
' RÜCKGABE:     cur     Taktfrequenz
'
'
' setzt:        clk_sec Anzahl Takte/Sekunde
'               cur_txt Taktfrequenz als formatierter Text
'               clk_dmy Durchschnittliche Anzahl Takte, die
'                       für clkGET() benötigt werden
'
' HINWEIS:      CheckRate gibt in 1/sec die Zeitspanne an,
'               die clkINI zwischen dem Lesen des CPU-Taktzählers
'               verstreichen läßt. Je höher der Wert, desto genauer
'               ist das Ergebnis (clk_sec/clk_dmy)
'
Function clkINI(Optional chkRate As Double = 0.5) As Currency
    Dim cur(3) As Currency
    Dim cu1    As Currency
    Dim cu2    As Currency
    
    If clk_sec = 0 Then
        API_PFrequency clk_frq
        API_PCounter cu1
        cu1 = cu1 + clk_frq * chkRate
        
        clkGET cur, 0
        clkGET cur, 2
        
        Do: API_PCounter cu2
            clk_dmy = (clk_dmy + clkGET(cur, 2)) / 2
        Loop Until cu2 >= cu1
        
        clk_sec = clkGET(cur, 0) * (1 / chkRate)
        cu1 = IIf(clk_sec > 100000, 100000, 100)
        cur_txt = "Running at " & _
            Format(clk_sec / cu1, "0.00") & _
            IIf(cu1 = 100, " MHz", " GHz")
    End If
    
    clkINI = clk_sec
End Function

' clkRUN        Zum Testen von Programmen/Funktionen
'
' AUFRUF:       clkRUN([md], [cnt], [txt], [@ret], [prn])
'
' EIN:          bol:md  .F.: Zähler initialisieren (Vorgabe)
'                       .T.: Zeit messen / Ausgabe
'               lng:cnt Nummer des zu verwendenden Zähler (Vorgabe = 1)
'               chr:txt Auszugebender Text
'               bol:prn nur mit md=.T.:
'                       .T.: Ergebnis per debug.print ausgeben (Vorgabe)
'                       .F.: Ermittelte Zeit nicht ausgeben
'
' AUS:          chr:txt Textausgabe
'
' RÜCKGABE:     chr     (nur mit md=.T.)
'                       txt & clkFMT(Ermittelte Zeit)
'
'
' Hinweise:     Die Funktion eignet sich vor allem, um den Zeitbedarf
'               von Programmteilen zu messen:
'
'               clkRUN
'               ... programm
'               clkRUN True
'
Function clkRUN( _
    Optional MD As Boolean, _
    Optional cnt As Long = 1, _
    Optional txt As String, _
    Optional ret As String, _
    Optional prn As Boolean = True) As String
    
    Dim dsp As String
    Dim tmp As Long
    
    If clk_sec = 0 Then clkINI
    
    tmp = cnt * 2 - 2
    
    If tmp >= 0 And tmp < 20 Then
        If MD Then
            clkGET clk_run, tmp
            clkRUN = clkFMT(clk_run(tmp + 1))
            
            On Error Resume Next
            dsp = Left$(": ", Len(txt) * 2)
            If prn Then Debug.Print txt; dsp; clkRUN
            ret = ret & Left$(vbCrLf, Len(ret) * 2) & txt & dsp & clkRUN
        
        Else
            DoEvents
            clkGET clk_run, tmp
        End If
    End If
End Function

' clkWAIT       Sleep-Funktion
'
' AUFRUF:       clkWAIT(Zeit, [cnt])
'
' EIN:          dbl:Zeit    Abzuwartende Zeit in sec
'               cur:Cnt     Zähler
'
' AUS:          dbl         Tatsächlich verstrichene Zeit/sec
'               cnt         Anzahl der Loops der ASM-Funktion
'                           > 1: Ergebnis ist verläßlich
'
' HINWEIS:      Die ASM-Funktion wird mit einem Array-Parameter
'               aufgerufen:
'               0: CPU-Taktzähler beim Funktionsaufruf
'               1: Differenz 0/1 und aktueller CPU-Taktzähler
'               2: Anzahl Takte, die abgewartet werden soll
'               3: Loop-Zähler. Ist der Loop-Zähler nach Ver-
'                  lassen der Funktion >1, wurde die ASM-Schleife
'                  mehr als einmal durchlaufen und ist das Ergeb-
'                  nis verläßlich. Allerdings wird der Aufwand,
'                  der hier für den Funktionsaufruf betrieben wird,
'                  nicht berücksichtigt!
'
Function clkWAIT(Sec As Double, Optional cnt As Currency) As Double
    Static asm(12) As Long

    If asm(0) = 0 Then
        asm(0) = &H4C8B310F:  asm(1) = &H1890424
        asm(2) = &H33045189:  asm(3) = &H184189C0
        asm(4) = &HF1C4189:   asm(5) = &H18418331
        asm(6) = &H1C518301:  asm(7) = &H1B012B00
        asm(8) = &H41890451:  asm(9) = &HC518908
        asm(10) = &H1B10412B: asm(11) = &HE3721451
        asm(12) = &H10C2
    End If
    
    ' *****************************************************

    Dim cur(3) As Currency
    
    cur(2) = Abs(Sec) * clk_sec
    ASM_cdLong asm(0), VarPtr(cur(0)), 0, 0, 0
    cnt = cur(3)
    clkWAIT = cur(1) / clk_sec
End Function


'--------- Ende Modul "cpuClock" alias cpuClock.bas ---------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.