Скорость
работы процессора, точный таймер Данная
тема уже обсуждалась, но у меня есть своя
реализация сабжа. Начиная с Pentium MMX, Intel ввели в
процессор счетчик тактов на 64 бита (Присутствуэт
точно и в К6). Для того чтобы посотреть на его
содержание, была введена команда "rdtsc"
(подробное описание в интеловской мануале). Эту
возможность можно использовать для реализации
сабжа.
Посоку Делфя не вкурсе насчет rdtsc, то
пришлось юзать опкод (0F31).
Привожу простенький примерчик юзания, Вы уж
извините - немножко кривоват получился, да и
ошибка компалера какая-то вылезла :( (V4 Bld5.104 Upd 2).
Кому интересно, поделитесь своими соображениями
по этому поводу. Особенно интерисует работа в
режиме когда меняется частота процессора (Duty Cycle,
StandBy).
Проверялось под еНТями на Пне 2 333.
-----------------------------------------------------------
// (C) 1999 ISV
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls, Buttons, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Timer1: TTimer;
Label2: TLabel;
Label3: TLabel;
Button1: TButton;
Button2: TButton;
Label4: TLabel;
procedure Timer1Timer(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Counter:integer; //Счетчик
срабатывания таймера
Start:int64;
//Начало
роботы
Previous:int64;
//Предыдущее значение
PStart,PStop:int64; //Для примера выч. времени
CurRate:integer; //Текущая
частота проца
function GetCPUClick:int64;
function GetTime(Start,Stop:int64):double;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// Функция работает на пнях ММХ или выше а
// также проверялась на К6
function TForm1.GetCPUClick:int64;
begin
asm
db 0fh,31h // Опкод для команды rdtsc
mov dword ptr result,eax
mov dword ptr result[4],edx
end;
// Не смешно :(. Без ?той штуки
// Компайлер выдает Internal error C1079
Result:=Result;
end;
// Время в секундах между старт и стоп
function TForm1.GetTime(Start,Stop:int64):double;
begin
try
result:=(Stop-Start)/CurRate
except
result:=0;
end;
end;
// Обработчик таймера считает текущую частоту,
выводит ее, а также
// усредненную частоту, текущий такт с момента
старта процессора.
// При постоянной частоте процессора желательно
интервал брать
побольше
// 1-5с для точного прощета частоты процессора.
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:int64;
begin
i:=GetCPUClick;
if Counter=0
then Start:=i
else begin
Label2.Caption:=Format('Частота общая:
%2f',[(i-Start)/(Counter*Timer1.Interval*1000)]);
Label3.Caption:=Format('Частота текущая:
%2f',[(i-Previous)/(Timer1.Interval*1000)]);
CurRate:=Round(((i-Previous)*1000)/(Timer1.Interval));
end;
Label1.Caption:='Такты: '+IntToStr(i);
Previous:=i;
Inc(Counter);
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
Counter:=0;
end;
// Заносим стартовое время для примера
procedure TForm1.Button1Click(Sender: TObject);
begin
PStart:=GetCPUClick;
end;
// Останавливаем отсчет времени и показуем соко
// прошло секунд
procedure TForm1.Button2Click(Sender: TObject);
begin
PStop:=GetCPUClick;
Label4.Caption:=Format('Время между нажатиями:
%gсек',[GetTime(PStart,PStop)])
end;
end.
Как получить сеpийные номеpа биоса и т.п.?
Вот пример как
можно даты БИОС материнской платы и видеокарты
выдрать.
То же самое можно с названием производителя и
версией.
В WinNT приходится читать не из ПЗУ а из реестра но
это достаточно надежно
- соотв ключи WinNT закрывает на запись и обновляет
при каждом старте (?).
Для Win9x можешь хоть весь БИОС напрямую читать.
Получить заводской номер винчестера
(не тот что getvolumeinfo дает) ИМХО
невозможно - порты IDE даже Win9x блокирует.
type
TRegistryRO = class (TRegistry)
function OpenKeyRO (const Key: string): Boolean;
end;
{ это уже ветхая история - был один глюк у D3}
implementation
uses WAPIInfo, Windows, SysUtils, StrUtils;
function TRegistryRO.OpenKeyRO (const Key: string): Boolean;
function IsRelative(const Value: string): Boolean;
begin Result := not ((Value <> '') and (Value[1] = '\')) end;
var
TempKey: HKey;
S: string;
Relative: Boolean;
begin
S := Key;
Relative := IsRelative(S);
if not Relative then Delete(S, 1, 1);
TempKey := 0;
Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
KEY_READ, TempKey) = ERROR_SUCCESS;
if Result then begin
if (CurrentKey <> 0) and Relative then S := CurrentPath +
'\' + S;
ChangeKey(TempKey, S);
end;
end;
function GetBIOSDate : string;
const
BIOSDatePtr = $0ffff5;
SystemKey = 'HARDWARE\DESCRIPTION\System';
BiosDateParam = 'SystemBiosDate';
var
p : pointer;
s : string[128];
begin
if OSisNT then begin
with TRegistryRO.Create do try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKeyRO (SystemKey) then begin
s := ReadString (BiosDateParam);
end;
finally Free;
end; { of try}
end
else try
s[0] := #8;
p := Pointer(BIOSDatePtr);
Move (p^, s[1], 8);
except FillChar (s[1], 8, '9');
end; { of try}
Result := copy (s, 1, 2) + copy (s, 4, 2) + copy (s, 7, 2);
end;
function GetVideoDate : string;
const
VideoDatePtr = $0C0000;
SystemKey = 'HARDWARE\DESCRIPTION\System';
VideoDateParam = 'VideoBiosDate';
var
p : pointer;
s : string[255];
begin
if OSisNT then begin
with TRegistryRO.Create do try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKeyRO (SystemKey)
then s := ReadString (VideoDateParam)
else s := 'NT/de/tected';
finally Free;
end; { of try}
end
else try
s[0] := #255;
p := Pointer(VideoDatePtr + 60); { первые $60 -
строка CopyRight}
Move (p^, s[1], 255);
if pos('/', s) > 2 then s := copy (s, pos('/', s) - 2,
8)
else begin
p := Pointer(VideoDatePtr + 60 + 250);
Move (p^, s[1], 255);
if pos('/', s) > 2 then s := copy (s,
pos('/', s) - 2, 8);
end;
except FillChar (s[1], 8, '9');
end; { of try}
Result := copy (s, 1, 2) + copy (s, 4, 2) + copy (s, 7, 2);
end;
unit WAPIInfo;
interface
uses Registry, SysUtils, Windows;
procedure GetOSVerInfo (var OSID : DWORD; var OSStr : string);
function OSisNT : boolean;
procedure GetCPUInfo (var CPUID : DWORD; var CPUStr : string);
procedure GetMemInfo (var MemStr : string);
implementation
procedure GetOSVerInfo (var OSID : DWORD; var OSStr : string);
var
OSVerInfo : TOSVersionInfo;
Reg : TRegistry;
s : string;
begin
OSVerInfo.dwOSVersionInfoSize := SizeOf (OSVerInfo);
GetVersionEx (OSVerInfo);
OSID := OSVerInfo.dwPlatformID;
case OSID of
VER_PLATFORM_WIN32S : OSStr := 'Windows 3+';
VER_PLATFORM_WIN32_WINDOWS : OSStr := 'Windows 95+';
VER_PLATFORM_WIN32_NT : begin
OSStr := 'Windows NT';
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey ('SYSTEM\CurrentControlSet\Control\', False)
then try
s := Reg.ReadString ('ProductOptions')
except s := ''
end;
if s = 'WINNT' then OSStr := OSStr + ' WorkStation'
else if s = 'SERVERNT' then OSStr := OSStr + ' Server 3.5
& hi'
else if s = 'LANMANNT' then OSStr := OSStr + ' Advanced
server 3.1';
Reg.Free;
end;
end;
with OSVerInfo do OSStr := OSStr + Format (' %d.%d (выпуск %d)',
[dwMajorVersion, dwMinorVersion, LoWord(dwBuildNumber)]);
end;
function OSisNT : boolean;
var
s : string;
i : DWORD;
begin
GetOSVerInfo (i, s);
Result := (i = VER_PLATFORM_WIN32_NT);
end;
procedure GetCPUInfo (var CPUID : DWORD; var CPUStr : string);
var SI : TSystemInfo;
begin
GetSystemInfo (SI);
CPUID := SI.dwProcessorType;
case CPUID of
386: CPUStr := '80386-совместимый процессор';
486: CPUStr := '80486-совместимый процессор';
586: CPUStr := 'Pentium-совместимый процессор';
else CPUStr := 'Неизвестный процессор';
end;
{ case SI.wProcessorArchitecture of
PROCESSOR_ARCHITECTURE_INTEL: ;
MIPS
ALPHA
PPC
UNKNOWN
end;}
end;
procedure GetMemInfo (var MemStr : string);
var MemInfo : TMemoryStatus;
begin
MemInfo.dwLength := SizeOf (MemInfo);
GlobalMemoryStatus (MemInfo);
with MemInfo do MemStr := Format ('ОЗУ: %0.2f M (свободно %0.2f M)'#$d+
' Файл подкачки: %0.2f M (свободно: %0.2f M)'#$d,
[(dwTotalPhys div 1024) / 1024,
(dwAvailPhys div 1024) / 1024,
(dwTotalPageFile div 1024) / 1024,
(dwAvailPageFile div 1024) / 1024]);
end;
end.
PS Возможно, эти процедуры не всегда дату
возвращают ;)
но то что практически всегда для разных
материнских/видео
плат возвращаются разные значения - проверено,
что мне
собственно и требовалось.
Andrey Sorokin from sunny ;) Saint-Petersburg anso@mail.ru
Russian Technology http://attend.to/rt anso@rt.spb.ru |