1040:
1041:
1042:
1043:
1044:
1045:
1046:
1047:
1048:
1049:
1050:
1051:
1052:
1053:
1054:
1055:
1056:
1057:
1058:
1059:
1060:
1061:
1062:
1063:
1064:
1065:
1066:
1067:
1068:
1069:
1070:
1071:
1072:
1073:
1074:
1075:
1076:
1077:
1078:
1079:
1080:
1081:
1082:
1083:
1084:
1085:
1086:
1087:
1088:
1089:
1090:
1091:
1092:
1093:
1094:
1095:
1096:
1097:
1098:
1099:
1100:
1101:
1102:
1103:
1104:
1105:
1106:
1107:
1108:
1109:
1110:
1111:
1112:
1113:
1114:
1115:
1116:
1117:
1118:
1119:
1120:
1121:
1122:
1123:
1124:
1125:
1126:
1127:
1128:
1129:
1130:
1131:
1132:
1133:
1134:
1135:
1136:
1137:
1138:
1139:
1140:
1141:
1142:
1143:
1144:
1145:
1146:
1147:
1148:
1149:
1150:
1151:
1152:
1153:
1154:
1155:
1156:
1157:
1158:
1159:
1160:
1161:
1162:
1163:
1164:
1165:
1166:
1167:
1168:
1169:
1170:
1171:
1172:
1173:
1174:
1175:
1176:
1177:
1178:
1179:
1180:
1181:
1182:
1183:
1184:
1185:
1186:

{ ... }
Function CPUSpeedInternal: Integer;
Var
    Timer: Int64;
    QPC1, QPC2, QPF: Int64;
    GTC: DWORD;
Begin
    Asm
    //Set the Thread and Process Priority to Realtime Class
    CALL    GetCurrentProcess               //Get the current process' handle
    PUSH    EAX
    CALL    GetPriorityClass                //Get the current process' priority class
    TEST    EAX, EAX
    MOV     EDX, NORMAL_PRIORITY_CLASS      //If failed, return to Normal Priority Class
    {$IFDEF DELPHI7_UP}
    CMOVZ   EAX, EDX
    {$ELSE}
    JNZ     @@CPUSpeed_GCPP_NoError
    MOV     EAX, EDX                        //If failed, return to Normal Priority Class
@@CPUSpeed_GCPP_NoError:
    {$ENDIF}
    PUSH    EAX

    CALL    GetCurrentThread                //Get the current thread's handle
    PUSH    EAX
    CALL    GetThreadPriority               //Get the current threads priority
    CMP     EAX, THREAD_PRIORITY_ERROR_RETURN
    MOV     EDX, THREAD_PRIORITY_NORMAL     //If failed, return to Normal Priority Class
    {$IFDEF DELPHI7_UP}
    CMOVZ   EAX, EDX
    {$ELSE}
    JNZ     @@CPUSpeed_GCTP_NoError
    MOV     EAX, EDX                        //If failed, return to Normal Priority Class
@@CPUSpeed_GCTP_NoError:
    {$ENDIF}
    PUSH    EAX

    PUSH    REALTIME_PRIORITY_CLASS
    CALL    GetCurrentProcess
    PUSH    EAX
    CALL    SetPriorityClass

    PUSH    THREAD_PRIORITY_TIME_CRITICAL
    CALL    GetCurrentThread
    PUSH    EAX
    CALL    SetThreadPriority

    //Make the Thread wait before measuring the CPU speed.
    //This is necessary to make the results more accurate.
    //Wait 1ms
    PUSH    1
    CALL    Sleep

    CALL    GetTickCount                //Low resolution Counter (GetTickCount) abfragen
    MOV     DWORD PTR [GTC], EAX

    LEA     EAX, DWORD PTR [QPC1]
    PUSH    EAX
    CALL    QueryPerformanceCounter

    //RDTSC
    DB      $0F, $31

    MOV     DWORD PTR [Timer], EAX
    MOV     DWORD PTR [Timer+$04], EDX

    //Wait 250ms
    PUSH    50         //250ms are enought to be accurate to about 1 MHz
    CALL    Sleep

    //RDTSC
    DB      $0F, $31

    SUB     EDX, DWORD PTR [Timer+$04]
    SUB     EAX, DWORD PTR [Timer]

    MOV     DWORD PTR [Timer], EAX
    MOV     DWORD PTR [Timer+$04], EDX

    LEA     EAX, DWORD PTR [QPC2]
    PUSH    EAX
    CALL    QueryPerformanceCounter

    LEA     EAX, DWORD PTR [QPF]
    PUSH    EAX
    CALL    QueryPerformanceFrequency

    CALL    GetTickCount                //Low resolution Counter (GetTickCount) abfragen
    SUB     EAX, DWORD PTR [GTC]
    MOV     DWORD PTR [GTC], EAX

    //Input argument remaining on Stack
    CALL    GetCurrentThread
    PUSH    EAX
    CALL    SetThreadPriority

    //Input argument remaining on Stack
    CALL    GetCurrentProcess
    PUSH    EAX
    CALL    SetPriorityClass
    End;

    If (QPF > 0) And (QPC2 - QPC1 > 0) Then
        Result := ((Timer * QPF) Div 1000000) Div (QPC2 - QPC1)
    Else
        Result := Timer Div (Int64(GTC) * 1000);
End;

Function CPUSpeed: Integer;
Const
    MaxDiff = 10;
Var
    S1, S2: Integer;
Begin
    S2 := CPUSpeedInternal;
    S1 := S2 + MaxDiff;
    While Abs(S2 - S1) >= MaxDiff Do
    Begin
        S1 := S2;
        S2 := CPUSpeedInternal;
    End;
    Result := (S1 + S2) Div 2;
End;

Function CPUSpeedEx: Integer;
Var
    Closest33: Integer;
    Closest50: Integer;
    Delta33: Integer;
    Delta50: Integer;
Begin
    Result := CPUSpeed;
    If Result < 20 Then
        Exit;

    Closest33 := (200 * ((Result * 6 + 100) Div 200)) Div 6;
    Delta33 := Abs(Result - Closest33);
    Closest50 := 50 * ((Result + 25) Div 50);
    Delta50 := Abs(Result - Closest50);

    If Delta33 <= Delta50 Then
        Result := Closest33
    Else
        Result := Closest50;

    If Result = 666 Then
        Inc(Result);
End;