Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
function GetCPUSpeed: real; function IsCPUID_Available: Boolean; assembler; register; asm PUSHFD { прямой доступ к флагам невозможен, только через стек } POP EAX { флаги в EAX } MOV EDX,EAX { сохраняем текущие флаги } xor EAX,$200000 { бит ID не нужен } PUSH EAX { в стек } POPFD { из стека в флаги, без бита ID } PUSHFD { возвращаем в стек } POP EAX { обратно в EAX } xor EAX,EDX { проверяем, появился ли бит ID } JZ @exit { нет, CPUID не доступен } MOV AL,True { Result=True } @exit: end; function hasTSC: Boolean; var Features: Longword; begin asm MOV Features,0 { Features = 0 } PUSH EBX xor EAX,EAX DW $A20F POP EBX CMP EAX,$01 JL @Fail xor EAX,EAX MOV EAX,$01 PUSH EBX DW $A20F MOV Features,EDX POP EBX @Fail: end; hasTSC := (Features and $10) <> 0; end; const DELAY = 500; var TimerHi, TimerLo: Integer; PriorityClass, Priority: Integer; begin Result := 0; if not (IsCPUID_Available and hasTSC) then Exit; PriorityClass := GetPriorityClass(GetCurrentProcess); Priority := GetThreadPriority(GetCurrentThread); SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS); SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL); SleepEx(10, FALSE); asm DB $0F { $0F31 op-code for RDTSC Pentium инструкции } DB $31 { возвращает 64-битное целое (Integer) } MOV TimerLo,EAX MOV TimerHi,EDX end; SleepEx(DELAY, FALSE); asm DB $0F { $0F31 op-code для RDTSC Pentium инструкции } DB $31 { возвращает 64-битное целое (Integer) } SUB EAX,TimerLo SBB EDX,TimerHi MOV TimerLo,EAX MOV TimerHi,EDX end; SetThreadPriority(GetCurrentThread, Priority); SetPriorityClass(GetCurrentProcess, PriorityClass); Result := TimerLo / (1000 * DELAY); end;