Вопрос # 1 521: …емые! Подскажите как средствами WIN API получить информацию о материнс… (Работа с устройствами и "железом")

Здравствуйте глубокоуважаемые! Подскажите как средствами WIN API получить информацию о материнской плате и процессоре (производитель, модель, чипсет, тактовая частота........)

Здравствуйте, Sanek!
Тема очень интересная и большая. Она не раз обсуждалась. По материнкам сказать ничего не могу, а по процессорам смотрите в приложении примеры:
1. Получение количества установленных процессоров;
2. Получение уровня процессора;
3. Как определить наличие сопроцессора;
4. Определение поддержки SSE;
5. Определение поддержки SSE2;
6. Определение фирмы производителя CPU;
7. Поддерживает ли процессор технологию 3DNow;
8. Как узнать тип процессора (через реестр);
9. Как узнать скорость процессора.
А так же в Атаче всем известный модуль CpuID.pas - 32 kb.
P.S. Желаю удачи.
К ответу прикреплён файл. Загрузить » (срок хранения: 60 дней с момента отправки ответа)

Приложение:

function GettingProcNum: string; //Win95 or later and NT3.1 or later
var
Struc: _SYSTEM_INFO;
begin
GetSystemInfo(Struc);
Result:=IntToStr(Struc.dwNumberOfProcessors);
end;
function GettingProcLevel: string; //Win95 or later and NT3.1 or later
var
Struc: _SYSTEM_INFO;
begin
GetSystemInfo(Struc);
Case Struc.wProcessorLevel of
3: Result:='Intel 80386';
4: Result:='Intel 80486';
5: Result:='Intel Pentium';
6: Result:='Intel Pentium II or better';
end;
end;
{$IFDEF WIN32}
uses Registry;
{$ENDIF}
function HasCoProcesser : bool;
{$IFDEF WIN32}
var
TheKey : hKey;
{$ENDIF}
begin
Result := true;
{$IFNDEF WIN32}
if GetWinFlags and Wf_80x87 = 0 then
Result := false;
{$ELSE}
if RegOpenKeyEx(HKEY_LOCAL_MACHINE,
'HARDWAREDESCRIPTIONSystemFloatingPointProcessor',0,
KEY_EXECUTE, TheKey) <> ERROR_SUCCESS then result := false;
RegCloseKey(TheKey);
{$ENDIF}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if HasCoProcesser then
ShowMessage('Has CoProcessor')
else
ShowMessage('No CoProcessor - Windows Emulation Mode');
end;
{ **** UBPFD *********** by delphibase.endimus.com ****
Copyright: Unknown
***************************************************** }
function CheckSSE: Boolean;
var
TempCheck: dword;
begin
TempCheck := 1;
asm
push ebx
mov eax,1
db $0F,$A2
test edx,$2000000
jz @NOSSE
mov edx,0
mov TempCheck,edx
@NOSSE:
pop ebx
end;
CheckSSE := (TempCheck = 0);
end;
{ **** UBPFD *********** by delphibase.endimus.com ****
Copyright: Unknown
***************************************************** }
function CheckSSE2: Boolean;
var
TempCheck: dword;
begin
TempCheck := 1;
asm
push ebx
mov eax,1
db $0F,$A2
test edx,$4000000
jz @NOSSE2
mov edx,0
mov TempCheck,edx
@NOSSE2:
pop ebx
end;
CheckSSE2 := (TempCheck = 0);
end;
{ **** UBPFD *********** by delphibase.endimus.com ****
Copyright:
***************************************************** }
type
TVendor = array[0..11] of char;
.........................
function GetCPUVendor: TVendor; assembler; register;
asm
PUSH EBX {Save affected register}
PUSH EDI
MOV EDI,EAX {@Result (TVendor)}
MOV EAX,0
DW $A20F {CPUID Command}
MOV EAX,EBX
XCHG EBX,ECX {save ECX result}
MOV ECX,4
@1:
STOSB
SHR EAX,8
LOOP @1
MOV EAX,EDX
MOV ECX,4
@2:
STOSB
SHR EAX,8
LOOP @2
MOV EAX,EBX
MOV ECX,4
@3:
STOSB
SHR EAX,8
LOOP @3
POP EDI {Restore registers}
POP EBX
end;
function 3DNowSupport: Boolean; assembler;
asm
push ebx
mov @Result, True
mov eax, $80000000
dw $A20F
cmp eax, $80000000
mov eax, $80000001
dw $A20F
test edx, $80000000
@NOEXTENDED:
mov @Result, False
@EXIT:
pop ebx
end;
{$endif}
function CPUType: string;
var
Reg: TRegistry;
begin
CPUType := '';
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('HardwareDescriptionSystemCentralProcessor', False) then
CPUType := Reg.ReadString('Identifier');
finally
Reg.Free;
end;
end;
function GetCPUSpeed: Double;
const DelayTime = 500;
var TimerHi : DWORD;
TimerLo : DWORD;
PriorityClass : Integer;
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;
// Usage ...
LabelCPUSpeed.Caption := Format('CPU speed: %f MHz', [GetCPUSpeed]);
function GetCPUSpeed: real;
function IsCPUID_Available: Boolean; assembler; register;
asm
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
MOV TimerLo,EAX
MOV TimerHi,EDX
end;
SleepEx(DELAY, FALSE);
asm
SUB EAX,TimerLo
SBB EDX,TimerHi
MOV TimerLo,EAX
MOV TimerHi,EDX
end;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result := TimerLo / (1000 * DELAY);
end;
const
ID_BIT=$200000; // EFLAGS ID bit
function GetCPUSpeed: Double;
const
DelayTime = 500;
var
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: Integer;
begin
try
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriorit(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);
except end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var cpuspeed:string;
begin
cpuspeed:=Format('%f MHz', [GetCPUSpeed]);
edit1.text := cpuspeed;
end;
function RdTSC : int64; register;
asm
db $0f, $31
end;
function GetCyclesPerSecond : int64;
var
hF, T, et, sc : int64;
begin
QueryPerformanceFrequency(hF); // HiTicks / second
QueryPerformanceCounter(T); // Determine start HiTicks
et := T + hF; // (Cycles are passing, but we can still USE them!)
sc := RdTSC; // Get start cycles
repeat // Use Hi Perf Timer to loop for 1 second
QueryPerformanceCounter(T); // Check ticks NOW
until (T >= et); // Break the moment we equal or exceed et
Result := RdTSC - sc; // Get stop cycles and calculate result
end;

Мини-форум вопроса

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 1 521

Мини-форум вопроса

Экспертная система Delphi.int.ru

Сообщество программистовОбщение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 1 521

Мини-форум вопроса

Сообщество программистов
Общение, помощь, обмен опытом