Скорость работы процессора, точный таймер

    Данная тема уже обсуждалась, но у меня есть своя реализация сабжа. Начиная с 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

main_back.gif (3425 bytes)

Используются технологии uCoz