Текущий архив: 2002.09.19;
Скачать: CL | DM;

Вниз

Как узнать частоту работы процессора   Найти похожие ветки 

← →
OlegG   (2002-07-26 16:59) [0]

Народ, подскажите, как с помощью WinApi узнать сведения о процессоре и материнской плате?

---

← →
VuDZ ©   (2002-07-27 02:00) [1]

1. Покапаться в реестре
2. Поискать в инете или в форуме

---

← →
Poirot ©   (2002-07-28 03:27) [2]

Я уже не помню откуда эта фигня, но вот она есть...

function TpavCPUInfo.MeasureProcessorClock: String;
var
Stamp, Count1, Count2, Freq: Int64;
PriorityClass, Priority : Integer;
begin
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
QueryPerformanceFrequency(Freq);
If Freq=0 then begin
MeasureProcessorClock:="0"; //таковое условие невозможно, но-на всякий случай...
EXIT;
end;
Count2:=0;
Try
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
//не знаю, как это пройдёт под NT и потомством. Там это зависит от прав процессов, но, кажется,
//при отсутствии прав на изменение приоритета запрос просто игнорируется, не вызывая ошибки
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
asm
db $0F,$31 /// rdtsc
MOV DWORD PTR Stamp, EAX
MOV DWORD PTR Stamp + 4, EDX
end;
QueryPerformanceCounter(Count1);
Sleep(100);
asm
db $0F,$31 /// rdtsc
SUB EAX, DWORD PTR Stamp
SBB EDX, DWORD PTR Stamp + 4
MOV DWORD PTR Stamp, EAX
MOV DWORD PTR Stamp + 4, EDX
end;
QueryPerformanceCounter(Count2);
Finally
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
End;
If Count2 > 0 //т.е. не было исключений в процессе измерения,
//(например, если процессор не знает команды RDTSC)
then
MeasureProcessorClock:=
FormatFloat("###.###",
Round(Stamp*1.0*Freq/(Count2-Count1))/1000000)
else
MeasureProcessorClock:="0";
end;


---

← →
NailMan ©   (2002-07-29 06:02) [3]

Если Дельфя не слишком древняя(и проц не старее Пентюха) попробуй так:

Function GetProcessorFrequency:Int64;
Var L,N:Int64;Last:Cardinal;
begin
Last:=GettickCount;
asm
push eax
push edx
xor eax,eax
xor EDX,edx
RDTSC
mov dword ptr L[0],eax
mov dword ptr L[4],edx
pop edx
pop eax
end;
repeat
until (Gettickcount-Last)>=1000;
asm
push eax
push edx
xor eax,eax
xor EDX,edx
RDTSC
mov dword ptr N[0],eax
mov dword ptr N[4],edx
pop edx
pop eax
end;
Result:=N-L;
end;

У меня на K6-2, D6, WinME, WinXP работает точно

---

Страницы: 1 вся ветка

Текущий архив: 2002.09.19;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.02 c