Delphi (3.) - Detekce typu procesoru, jeho frekvence a využití
Protože se mi do rukou (na Harddisk) dostaly tyto zdrojáky, rozhodl jsem se že vám je tu předlořím ať si je taky vyzkoušíte. Někdy se můžou hodit.
Detekce frekvence procesoru
Pro použití této funkce stačí pouze napsat: Label1.Caption := Format('%f MHz', [GetCPUSpeed]);
function GetCPUSpeed: Double;
const
DelayTime = 500; // Čas měření
var
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: Integer;
begin
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread,
THREAD_PRIORITY_TIME_CRITICAL);
Sleep(10);
asm
dw 310Fh // rdtsc
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh // rdtsc
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result := TimerLo / (1000.0 * DelayTime);
end;
Detekce vytížení procesoru
Jak vidíte, informace nejen o využití procesoru se zaznamenávají do registru OS Windows...
uses
Registry;
var
Reg: TRegistry;
procedure TForm1.FormCreate(Sender: TObject);
begin
Reg := TRegistry.Create;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
CPUU : integer;
begin
Reg.RootKey := HKEY_DYN_DATA;
Reg.OpenKey('PerfStats\StatData',false);
Reg.ReadBinaryData('KERNEL\CPUUsage',CPUU,SizeOf(Integer));
Reg.CloseKey;
Label1.Caption := IntToStr(CPUU)+'%';
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Reg.Free;
end;
Detekce typu procesoru
Here is a Delphi unit to detect the CPU type, modified from Intel's code:
unit CpuId;
{ This code comes from Intel, and has been modified for Delphi's
inline assembler. Since Intel made the original code freely
available, I am making my changes freely available.
Share and enjoy!
Ray Lischner
Tempest Software
6/18/95 }
interface
type
TCpuType = (cpu8086, cpu80286, cpu386, cpu486, cpuPentium);
{ Return the type of the current CPU }
{ All the types currently known. As new types are created,
add suitable names, and extend the case statement in
CpuTypeString. }
function CpuType: TCpuType;
{ Return the type as a short string }
function CpuTypeString: String;
implementation
uses SysUtils;
function CpuType: TCpuType; assembler;
asm
push DS
{ First check for an 8086 CPU }
{Bits 12-15 of the FLAGS register are always set on the 8086 processor.}
pushf { save EFLAGS }
pop bx { store EFLAGS in BX }
mov ax,0fffh { clear bits 12-15 }
and ax,bx { in EFLAGS }
push ax { store new EFLAGS value on stack }
popf { replace current EFLAGS value }
pushf { set new EFLAGS }
pop ax { store new EFLAGS in AX }
and ax,0f000h { if bits 12-15 are set, then CPU }
cmp ax,0f000h { is an 8086/8088 }
mov ax, cpu8086 { turn on 8086/8088 flag }
je @@End_CpuType
{ 80286 CPU check }
{Bits 12-15 of the FLAGS register are
always clear on the 80286 processor. }
or bx,0f000h { try to set bits 12-15 }
push bx
popf
pushf
pop ax
and ax,0f000h { if bits 12-15 are cleared, CPU=80286 }
mov ax, cpu80286 { turn on 80286 flag }
jz @@End_CpuType
{ To test for 386 or better, we need to use 32 bit instructions,
but the 16-bit Delphi assembler does not recognize the 32 bit
opcodes or operands. Instead, use the 66H operand size prefix to change
each instruction to its 32-bit equivalent. For 32-bit immediate
operands, we also need to store the high word of the operand
immediately following the instruction. The 32-bit instruction
is shown in a comment after the 66H instruction.}
{ i386 CPU check }
{The AC bit, bit #18, is a new bit introduced in the EFLAGS
register on the i486 DX CPU to generate alignment faults.
This bit can not be set on the i386 CPU. }
db 66h { pushfd }
pushf
db 66h { pop eax }
pop ax { get original EFLAGS }
db 66h { mov ecx, eax }
mov cx,ax { save original EFLAGS }
db 66h { xor eax,40000h }
xor ax,0h { flip AC bit in EFLAGS }
dw 0004h
db 66h { push eax }
push ax { save for EFLAGS }
db 66h { popfd }
popf { copy to EFLAGS }
db 66h { pushfd }
pushf { push EFLAGS }
db 66h { pop eax }
pop ax { get new EFLAGS value }
db 66h { xor eax,ecx }
xor ax,cx { can't toggle AC bit, CPU=Intel386 }
mov ax, cpu386 { turn on 386 flag }
je @@End_CpuType
{ i486 DX CPU / i487 SX MCP and i486 SX CPU checking}
{Checking for ability to set/clear ID flag (Bit 21) in EFLAGS
which indicates the presence of a processor
with the ability to use the CPUID instruction. }
db 66h { pushfd }
pushf { push original EFLAGS }
db 66h { pop eax }
pop ax { get original EFLAGS in eax }
db 66h { mov ecx, eax }
mov cx,ax { save original EFLAGS in ecx }
db 66h { xor eax,200000h }
xor ax,0h { flip ID bit in EFLAGS }
dw 0020h
db 66h { push eax }
push ax { save for EFLAGS }
db 66h { popfd }
popf { copy to EFLAGS }
db 66h { pushfd }
pushf { push EFLAGS }
db 66h { pop eax }
pop ax { get new EFLAGS value }
db 66h { xor eax, ecx }
xor ax, cx
mov ax, cpu486 { turn on i486 flag }
je @@End_CpuType { if ID bit cannot be changed, CPU=486 }
{ without CPUID instruction functionality }
{ Execute CPUID instruction to determine vendor, family,
model and stepping. The use of the CPUID instruction used
in this program can be used for B0 and later steppings
of the P5 processor. }
db 66h { mov eax, 1 }
mov ax, 1 { set up for CPUID instruction }
dw 0
db 66h { cpuid }
db 0Fh { Hardcoded opcode for CPUID instruction }
db 0a2h
db 66h { and eax, 0F00H }
and ax, 0F00H { mask everything but family }
dw 0
db 66h { shr eax, 8 }
shr ax, 8 { shift the cpu type down to the low byte }
sub ax, 1 { subtract 1 to map to TCpuType }
@@End_CpuType:
pop ds
end;
function CpuTypeString: String;
var
kind: TCpuType;
begin
kind := CpuType;
case kind of
cpu8086: Result := '8086';
cpu80286: Result := '80286';
cpu386: Result := '386';
cpu486: Result := '486';
cpuPentium: Result := 'Pentium';
else
{ Try to be flexible for future cpu types, e.g., P6. }
Result := Format('P%d', [Ord(kind)]);
end;
end;
end.
Vyšlo 25.08.2001, v blogu: 0 1 2 3 4 5 6 7 8
Děkuji, že jste se rozhodl(a) přečíst tento článek. Budu rád i za komentář. Pokud Vás tento článek zaujal a rádi byste jej doporučili ostatním, podpořte mně prosím tím, že věnujete minutku svého času a uděláte mi reklamu na linkuj.cz, vybrali.sme.sk či jagg.cz. Přeji příjemné čtení
Poslední články
- 3D Studio MAX (5.) - Přízemní mlha ve 3D Studiu MAX
- Photoshop Tutoriály (2.) - Temná hvězdná obloha
- OpenGL (2.) - Čtverec s texturou
- OpenGL (1.) - Čtverec s interpolací barvy
- 3D Studio MAX (4.) - Jak vytvořit laser
- 3D Studio MAX (3.) - Tvorba 3D krajiny
- Delphi (4.) - Zajímavé zdrojáky
- Delphi (3.) - Detekce typu procesoru, jeho frekvence a využití
- Delphi (2.) - Práce se soubory, *.ini soubory a registry
- Photoshop tutoriály (1.) - Ohnivé koule
- Delphi (1.) - Jak zobrazit startovací obrázek
- 3D Studio MAX (2.) - Jak na ohnivé explose
- 3D Studio MAX (1.) - Panel nástrojů ve 3D Studiu MAX