1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:

Unit uCounter;

Interface

Uses Windows, SysUtils;

Type
  ECounter=Class(Exception);

  TCounter=Class
  Private
    mCPUFrequency : Int64;
    mStart        : Int64;
    mTimeCritical : Boolean;
    mPriorityClass: Cardinal;
    mPriority     : Cardinal;
    Function RDTSC: Int64;
    Function IsRDTSCPresent: Boolean;
    Procedure SetTimeCritical(active: Boolean);
    Procedure CalcCPUFrequency;
  Public
    Constructor Create(StartTimeCritical: Boolean = False);
    Procedure Start(TimeCritical: Boolean = False);
    Function Stop(StopTimeCritical: Boolean = True): Double;
    Function GetCPUFrequency: Double;
    Destructor Destroy; Override;
  End;

Implementation

Constructor TCounter.Create(StartTimeCritical: Boolean = False);
Begin
  Inherited Create;
  If Not IsRDTSCPresent Then
    Raise ECounter.Create('Time-Stamp Counter (RDTSC) ist nicht verfügbar!');
  mPriorityClass:=GetPriorityClass(GetCurrentProcess);
  mPriority:=GetThreadPriority(GetCurrentThread);
  CalcCPUFrequency;
  Start(StartTimeCritical);
End;

Function TCounter.RDTSC: Int64; Assembler;
asm
       DW    0310Fh
End;

Function TCounter.IsRDTSCPresent: Boolean;

  Function HasRDTSC: Boolean; Assembler;
  asm
         PUSH    EBX
         PUSHFD
         PUSHFD
         POP     EAX
         MOV     EDX,EAX
         XOR     EAX,0040000h
         PUSH    EAX
         POPFD
         PUSHFD
         POP     EAX
         XOR     EAX,EDX
         JZ      @@1
         PUSHFD
         POP     EAX
         MOV     EDX,EAX
         XOR     EAX,0200000h
         PUSH    EAX
         POPFD
         PUSHFD
         POP     EAX
         XOR     EAX,EDX
    @@1: POPFD
         TEST    EAX,EAX
         JZ      @@2
         MOV     EAX,1
         DW      0A20Fh
         TEST    EDX,010h
        SETNZ   AL
    @@2: POP     EBX
  End;

Begin
  Try
    Result:=HasRDTSC;
    If Result Then RDTSC;
  Except
    Result:=False;
  End;
End;

procedure TCounter.SetTimeCritical(active: Boolean);
begin
  mTimeCritical:=active;
  If active Then Begin
    SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
    SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
  End Else Begin
    SetThreadPriority(GetCurrentThread, mPriority);
    SetPriorityClass(GetCurrentProcess, mPriorityClass);
  End;
end;

Procedure TCounter.Start(TimeCritical: Boolean = False);
Begin
  If TimeCritical And Not mTimeCritical Then
    SetTimeCritical(True);
  mStart:=RDTSC;
End;

Function TCounter.Stop(StopTimeCritical: Boolean=True): Double;
Begin
  Result:=(RDTSC-mStart)*1000/mCPUFrequency;
  If StopTimeCritical And mTimeCritical Then
    SetTimeCritical(False);
End;

Procedure TCounter.CalcCPUFrequency;
Var
  C, F, S1, E1, S2, E2: Int64;
Begin
  SetTimeCritical(True);
  QueryPerformanceFrequency(F);
  C:=F*2;
  QueryPerformanceCounter(S1);
  S2:=RDTSC;
  While C>0 Do Dec(C);
  QueryPerformanceCounter(E1);
  E2:=RDTSC;
  SetTimeCritical(False);

  mCPUFrequency:=Round((E2-S2)*F/(E1-S1));
End;

Function TCounter.GetCPUFrequency: Double;
Begin
  Result:=mCPUFrequency/1000000;
End;

Destructor TCounter.Destroy;
Begin
  If mTimeCritical Then
    SetTimeCritical(False);
  Inherited;
End;

End.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

procedure TForm1.FormCreate(Sender: TObject);
Var Counter: TCounter;
begin
  Counter:=TCounter.Create;
  Try
    Counter.Start;
    // mach irgendwas... 
    Caption:=FloatToStr(Counter.Stop);
  Finally
    Counter.Free;
  End;
End;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

Function TCounter.Stop: Double; 
Var PriorityClass, Priority: Cardinal; 
Begin 
  PriorityClass:=GetPriorityClass(GetCurrentProcess); 
  Priority:=GetThreadPriority(GetCurrentThread); 
  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS); 
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL); 

  Result:=(RDTSC-mStart)*1000/mCPUFrequency; 

  SetThreadPriority(GetCurrentThread, Priority); 
  SetPriorityClass(GetCurrentProcess, PriorityClass); 
End;