Реферат: Утилита диагностики компьютера

R2:=Tregistry.create;

R2.RootKey:=HKEY_LOCAL_MACHINE;

r2.OpenKey(processordir,false);

processorname.caption:=r2.readstring('Identifier');

vident.caption:=r2.readstring('VendorIdentifier');

if not (r2.readstring('MMXIdentifier')='')then

mmx1.caption:=r2.readstring('MMXIdentifier')

else

mmx1.caption:='нет';

Label48.Caption:=inttostr(Trunc(GetCPUSpeed))+' MHz';

{}

{memory}

memorystatus.dwlength:=sizeof(memorystatus);

globalmemorystatus(memorystatus);

physmemory.caption:=floattostr(memorystatus.dwtotalphys div 1024 div 1024)+' Мега  '+'('+

floattostr(memorystatus.dwtotalphys / 1024 / 1024)+')';

avail.caption:=floattostr(memorystatus.dwavailphys / 1024 / 1024)+' Мег';

maxpf.caption:=floattostr(memorystatus.dwtotalpagefile / 1024 / 1024);

pffree.caption:=floattostr(memorystatus.dwavailpagefile / 1024 / 1024);

{}

{Windows info}

winid.caption:=getwinid;

winkey.caption:=getwinkey;

ver1.Caption:=getwinname;

username.caption:=getusernme;

//plusver.caption:=getplusvernum;

company.caption:=getorgname;

resolution.caption:=getscreenresolution;

{printer}

try

getprofilestring('windows','device',',,,',buffer,256);

s:=strpas(buffer);

defprn.Lines.add(' Принтер: '+copy(s,1,pos(',',s)-1));

delete(s,1,pos(',',s)-1);

defprn.lines.add(' Порт: '+copy(s,1,pos(',',s)-1));

delete(s,1,pos(',',s)-1);

defprn.lines.add(' Драйвер и порт:'+ s);

except

showmessage('Printer not found');

end;

{keyboard}

ktype:=GetKeyboardType(0);

case ktype of

     1:keytype.caption:='IBM PC/XT или совместимая (83-клавииши)';

     2:keytype.caption:='Olivetti "ICO" (102-клавиши)';

     3:keytype.caption:='IBM PC/AT (84-клавиши) и другие';

     4:keytype.caption:='IBM-расширенная (101/102-клавиши)';

     5:keytype.caption:='Nokia 1050 and similar keyboards';

     6:keytype.caption:='Nokia 9140 and similar keyboards';

     7:keytype.caption:='Japanese keyboard';

end;

numoffunckey.Caption:=inttostr(getkeyboardtype(2));

{

typ.hide;

label14.hide;

{windir}

getwindowsdirectory(sp,max_path);

wd:=strpas(sp);

{windir.caption:=wd;

progrfiles.caption:=getprogramfilesdir;

label13.hide;

label12.hide;

{Windows version}

OSVerInfo.dwOsversioninfosize:=sizeof(osverinfo);

getversionex(osverinfo);

case osverinfo.dwplatformid of

ver_platform_win32s:os.caption:='Windows 3.x';

ver_platform_win32_windows:os.Caption:='Windows 95 (98)';

ver_platform_win32_nt:os.caption:='Windows NT';

end;

with osverinfo do

begin

winver:=format('%d.%d',[dwmajorversion, dwminorversion]);

build:=format('%d', [LoWord(dwbuildnumber)]);

osver.caption:=winver;

osver.caption:=osver.caption+'  (сборка: '+build+')';

end;

{boot}

{oottype.caption:=getboottype;

{printer}

{Prntrs.items:=Printer.Printers;}

prn.items:=Printer.Printers;

try

fnt.items:=printer.fonts;

except

end;

prn.ItemIndex:=0;

edit2.text:=inttostr(printer.pageheight);

edit1.text:=inttostr(printer.pagewidth);

GetPrName(Processor1);

GetPrName(pt);

resolution.Caption :=inttostr(Screen.Width)+'на'+inttostr(Screen.Height);

timer1.Enabled:=true;

end;

function OpenCD(Drive : Char) : Boolean;

Var

  Res : MciError;

  OpenParm: TMCI_Open_Parms;

  Flags : DWord;

  S : String;

  DeviceID : Word;

begin

  Result := False;

  S := Drive + ':';

  Flags := mci_Open_Type or mci_Open_Element;

  With OpenParm do begin

    dwCallback := 0;

    lpstrDeviceType := 'CDAudio';

    lpstrElementName := PChar(S);

  end;

  {Эта строчка необходима для правильной работы функции IntellectCD}

  Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));

  IF Res <> 0 Then Exit;

  DeviceID := OpenParm.wDeviceID;

  try

    Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);

    IF Res = 0 Then Exit;

    Result := True;

  finally

    mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));

  end;

end;

function CloseCD(Drive : Char) : Boolean;

Var

  Res : MciError;

  OpenParm: TMCI_Open_Parms;

  Flags : DWord;

  S : String;

  DeviceID : Word;

begin

  Result := False;

  S := Drive + ':';

  Flags := mci_Open_Type or mci_Open_Element;

  With OpenParm do begin

    dwCallback := 0;

    lpstrDeviceType := 'CDAudio';

    lpstrElementName := PChar(S);

  end;

  Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));

  IF Res <> 0 Then Exit;

  DeviceID := OpenParm.wDeviceID;

  try

    Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);

    IF Res = 0 Then

    Result := True;

  finally

    mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));

  end;

end;

procedure Delay(msecs : Longint);

var

FirstTick : Longint;

begin

FirstTick := GetTickCount;

repeat

Application.ProcessMessages;

until GetTickCount - FirstTick >= msecs;

end;

procedure TDiadnostic.Button1Click(Sender: TObject);

var disk1:integer;

begin

for disk1:=0 to diskname.items.count-1 do

begin

if CheckDriveType(diskname.items[disk1][1])='CD-ROM'

then

begin

opencd(diskname.items[disk1][1]);

delay(5000);

closecd(diskname.items[disk1][1]);

end;

end;

end;

procedure TDiadnostic.SpeedButton1Click(Sender: TObject);

begin

form1.show;

end;

procedure TDiadnostic.SpeedButton2Click(Sender: TObject);

begin

//ShellExecute(handle,nil,'mem.exe',nil,nil,sw_restore);

MessageDlg('Тестирующая программа загружена в оперативную память',mtInformation,[mbok],0);

end;

end.

//модуль тестирования процессора

unit ProcessorClockCounter;

interface

uses  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type

  TClockPriority=(cpIdle, cpNormal, cpHigh, cpRealTime, cpProcessDefined);

  TPrecizeProc = procedure(Sender: TObject) of Object;

  TProcessorClockCounter = class(TComponent)

  private

   FCache:array[0..(1 shl 19) - 1] of byte;  // 512 Kb NOP instructions is enough to clear cache

   FStarted:DWORD;

   FClockPriority:TClockPriority;

   FProcessHandle:HWND;

   FCurrentProcessPriority: Integer;

   FDesiredProcessPriority: Integer;

   FThreadHandle:HWND;

   FCurrentThreadPriority: Integer;

   FDesiredThreadPriority: Integer;

   FCalibration:int64;                //used to

   FPrecizeCalibration:int64;

   FStartValue:int64;

   FStopValue:int64;

   FDeltaValue:int64;

   FPrecizeProc:TPrecizeProc;

   FCounterSupported:boolean;

   procedure PrecizeStart;

   procedure PrecizeStartInCache;

   procedure GetProcInf;

   procedure SetClockPriority(Value: TClockPriority);

   procedure ProcedureWithoutInstruction; //description is in code

   function  GetClock:Int64; register;

   function GetStarted:Boolean;

  protected

   procedure AdjustPriority; virtual; // internal used in constructor to setup parameters when class is created in RunTime

   function  CheckCounterSupported:boolean;

  public

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

   procedure Calibrate;

   procedure Start;

   procedure Stop;

   procedure EraseCache;

   procedure TestPrecizeProc; virtual;

   procedure TestPrecizeProcInCache; virtual;

   property Counter:int64 read FDeltaValue;    // contain the measured test clock pulses (StopValue - StartValue - Calibration)

   property StartValue:int64 read FStartValue; // Value on the begining

   property StopValue:int64 read FStopValue;   // Value on test finished

   property Started:Boolean read GetStarted;

   property CurrentClock:int64 read GetClock;  // for longer tests this could be use to get current counter

  published

   property ClockPriority:TClockPriority read FClockPriority write SetClockPriority default cpNormal;

   property Calibration:int64 read FCalibration; // this is used to nullify self code execution timing

   property OnPrecizeProc:TPrecizeProc read FPrecizeProc write FPrecizeProc; // user can define it for testing part of code inside it

   property CounterSupported:boolean read FCounterSupported;

  end;

procedure Register;

implementation

procedure Register;

begin

  RegisterComponents('ASM Utils', [TProcessorClockCounter]);

end;

constructor TProcessorClockCounter.Create(AOwner: TComponent);

var n:integer;

begin

 inherited create(AOwner);

 FCounterSupported:=CheckCounterSupported;

 for n:=0 to High(FCache)-1 do FCache[n]:=$90; // fill with NOP instructions

 FCache[High(FCache)]:=$C3;                    // the last is the RET instruction

 FClockPriority:=cpNormal;

 FStarted:=0;

 FDesiredProcessPriority:=NORMAL_PRIORITY_CLASS;

 FDesiredThreadPriority :=THREAD_PRIORITY_NORMAL;

 AdjustPriority;

 Calibrate;

 FStartValue:=0;

 FStopValue:=0;

 FDeltaValue:=0;

end;

destructor TProcessorClockCounter.Destroy;

begin

inherited destroy;

end;

procedure TProcessorClockCounter.GetProcInf;

begin

 FProcessHandle:=GetCurrentProcess;

 FCurrentProcessPriority:=GetPriorityClass(FProcessHandle);

 FThreadHandle:=GetCurrentThread;

 FCurrentThreadPriority:=GetThreadPriority(FThreadHandle);

end;

procedure TProcessorClockCounter.AdjustPriority;

begin

GetProcInf;

 case FDesiredProcessPriority of

  IDLE_PRIORITY_CLASS:     FClockPriority:=cpIdle;

  NORMAL_PRIORITY_CLASS:   FClockPriority:=cpNormal;

  HIGH_PRIORITY_CLASS:     FClockPriority:=cpHigh;

  REALTIME_PRIORITY_CLASS: FClockPriority:=cpRealTime;

 end;

end;

procedure TProcessorClockCounter.SetClockPriority(Value: TClockPriority);

begin

 if Value<>FClockPriority then

  begin

   FClockPriority:=Value;

   case FClockPriority of

    cpIdle:    begin

               FDesiredProcessPriority:=IDLE_PRIORITY_CLASS;

               FDesiredThreadPriority :=THREAD_PRIORITY_IDLE;

               end;

    cpNormal:  begin

               FDesiredProcessPriority:=NORMAL_PRIORITY_CLASS;

               FDesiredThreadPriority :=THREAD_PRIORITY_NORMAL;

               end;

    cpHigh:    begin

               FDesiredProcessPriority:=HIGH_PRIORITY_CLASS;

               FDesiredThreadPriority :=THREAD_PRIORITY_HIGHEST;

               end;

    cpRealTime:begin

               FDesiredProcessPriority:=REALTIME_PRIORITY_CLASS;

               FDesiredThreadPriority :=THREAD_PRIORITY_TIME_CRITICAL;

               end;

    cpProcessDefined:

               begin

               FDesiredProcessPriority:=FCurrentProcessPriority;

               FDesiredThreadPriority :=FCurrentThreadPriority;

               end;

   end;

   Calibrate;

  end;

end;

procedure TProcessorClockCounter.TestPrecizeProc;

// This procedure is intended for testing small block of

// code when it must be put in the processor cache

begin

FDeltaValue:=0;

if FCounterSupported and assigned(FPrecizeProc) then

 begin

 PrecizeStart;                     // start test

 end;

end;

procedure TProcessorClockCounter.TestPrecizeProcInCache;

// This procedure is intended for testing small block of

// code when it is already in the processor cache

begin

FDeltaValue:=0;

if FCounterSupported and  assigned(FPrecizeProc) then

 begin

 EraseCache;

 PrecizeStartInCache;              // first test will fill processor cache

 PrecizeStartInCache;              // second test

                                   // generate calibration value for

                                   // code already put in the cache

 end;

end;

procedure TProcessorClockCounter.ProcedureWithoutInstruction;

// this is used for calibration! DO NOT CHANGE

asm

 ret

end;

procedure TProcessorClockCounter.EraseCache; register;

asm

  push ebx

  lea ebx,[eax + FCache]

  call ebx               // force call to code in array :)

  pop ebx                // this will fill level2 cache with NOPs (For motherboards with 1 Mb level 2 cache,

  ret                    // size of array should be increased to 1 Mb)

 // next instructions are never executed but need for proper align of 16 byte.

 // Some processors has different execution times when code is not 16 byte aligned

 // Actually, (on some processors), internal mechanism of level 1 cache (cache built

 // in processor) filling is designed to catch memory block faster, when

 // it is 16 byte aligned !!!

  nop

  nop

  nop

  nop

  nop

  nop

end;

function TProcessorClockCounter.GetClock: Int64; register;

asm

 push edx

 push ebx

 push eax

 mov ebx,eax

 xor eax,eax                            // EAX & EDX are initialized to zero for

 mov edx,eax                            // testing counter support

 DW $310f                               // This instruction will make exception

 sub eax,dword ptr [ebx+FStartValue]    // or do nothing on processors wthout

 sbb edx,dword ptr [ebx+FStartValue+4]  // counter support

 sub eax,dword ptr [ebx+FCalibration]

 sbb edx,dword ptr [ebx+FCalibration+4]

 mov dword ptr [esp + $10],eax

 mov dword ptr [esp + $14],edx

 pop eax

 pop ebx

 pop edx

 ret

end;

procedure TProcessorClockCounter.PrecizeStartInCache; register;

asm

//this address should be 16 byte aligned

 push edx

 push ebx

 push eax

 mov ebx,eax

 push eax

 mov dword ptr [ebx + FStarted],1           // started:=true

 DW $310f                                   //START

 mov dword ptr [ebx + FStartValue],eax      // startvalue:=counter

 mov dword ptr [ebx + FStartValue + 4],edx

 mov edx,[ebx + FPrecizeProc + 4]           //time equvialent

 mov ebx,ebx

 nop

 nop

 nop

 call ProcedureWithoutInstruction           // call procedure with immediate back

 DW $310f                                   //STOP

 mov dword ptr [ebx + FStopValue],eax       // stopvalue:=counter

 mov dword ptr [ebx + FStopValue + 4],edx

 sub eax,dword ptr [ebx + FStartValue]

 sbb edx,dword ptr [ebx + FStartValue + 4]

 mov dword ptr [ebx + FPrecizeCalibration],eax     // calibration:=stopvalue - startvalue

 mov dword ptr [ebx + FPrecizeCalibration + 4],edx

 nop                                         // need for proper align !!!

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 DW $310f                                   //START

 mov dword ptr [ebx + FStartValue],eax      // startvalue:=counter

 mov dword ptr [ebx + FStartValue + 4],edx

 mov eax,[ebx + FPrecizeProc + 4]

 mov edx,ebx

 call [ebx + FPrecizeProc]

 DW $310f                                   //STOP

 pop ebx

 mov dword ptr [ebx + FStopValue],eax       // stopvalue:=counter

 mov dword ptr [ebx + FStopValue + 4],edx

 sub eax,dword ptr [ebx + FStartValue]

 sbb edx,dword ptr [ebx + FStartValue + 4]

 sub eax,dword ptr [ebx + FPrecizeCalibration]

 sbb edx,dword ptr [ebx + FPrecizeCalibration + 4]

 mov dword ptr [ebx + FDeltaValue],eax      // deltavalue:=stopvalue - startvalue - calibration

 mov dword ptr [ebx + FDeltaValue + 4],edx

 pop eax

 pop ebx

 pop edx

 ret

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 nop

end;

procedure TProcessorClockCounter.PrecizeStart; register;

asm

//this address should be 16 byte aligned

 push edx

 push ebx

 push eax

 call EraseCache                            // fill cache with NOPs while executing it

 mov ebx,eax

 push eax

 mov dword ptr [ebx + FStarted],1           // started:=true

 nop                                        // need for proper align

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 nop

 DW $310f                                   //START

 mov dword ptr [ebx + FStartValue],eax      // startvalue:=counter

 mov dword ptr [ebx + FStartValue + 4],edx

 mov edx,[ebx + FPrecizeProc + 4]           //time equvivalent

 mov ebx,ebx

 nop

 nop

 nop

 call ProcedureWithoutInstruction           // call procedure with immediate back

 DW $310f                                   //STOP

 mov dword ptr [ebx + FStopValue],eax       // stopvalue:=counter

 mov dword ptr [ebx + FStopValue + 4],edx

 sub eax,dword ptr [ebx + FStartValue]

 sbb edx,dword ptr [ebx + FStartValue + 4]

 mov dword ptr [ebx + FPrecizeCalibration],eax     // calibration:=stopvalue - startvalue

 mov dword ptr [ebx + FPrecizeCalibration + 4],edx

 mov eax,ebx

 call EraseCache;                            // fill cache with NOPs while executing it

 nop                                         // need for proper align !!!

 nop

 nop

 nop

 nop

 DW $310f                                   //START

 mov dword ptr [ebx + FStartValue],eax      // startvalue:=counter

 mov dword ptr [ebx + FStartValue + 4],edx

 mov eax,[ebx + FPrecizeProc + 4]

 mov edx,ebx

 call [ebx + FPrecizeProc]

 DW $310f                                   //STOP

 pop ebx

 mov dword ptr [ebx + FStopValue],eax       // stopvalue:=counter

 mov dword ptr [ebx + FStopValue + 4],edx

 sub eax,dword ptr [ebx + FStartValue]

 sbb edx,dword ptr [ebx + FStartValue + 4]

 sub eax,dword ptr [ebx + FPrecizeCalibration]

 sbb edx,dword ptr [ebx + FPrecizeCalibration + 4]

 mov dword ptr [ebx + FDeltaValue],eax      // deltavalue:=stopvalue - startvalue - calibration

 mov dword ptr [ebx + FDeltaValue + 4],edx

 pop eax

 pop ebx

 pop edx

end;

end.

//модуль диагностики

unit Systeminfo;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

  Dialogs,extctrls;

type TDialupAdapterInfo = record //Информация о Dialup адаптере

  alignment:dword;

  buffer:dword;

  bytesrecieved:dword;

  bytesXmit:dword;

  ConnectSpeed:dword;

  CRC:dword;

  framesrecieved:dword;

  FramesXmit:dword;

  Framing:dword;

  runts:dword;

  Overrun:dword;

  timeout:dword;

  totalbytesrecieved:dword;

  totalbytesXmit:dword;

end;

type TKernelInfo = record

  CpuUsagePcnt:dword;

  Numthreads:dword;

  NumVMS:dword;

end;

type TFATInfo = record

  BreadsSec:dword;

  BwritesSec:dword;

  Dirtydata:dword;

  ReadsSec:dword;

  WritesSec:dword;

end;

type TVMMInfo = record

  CDiscards:dword;

  CInstancefaults:dword;

  CPageFaults:dword;

  cPageIns:dword;

  cPageOuts:dword;

  cpgCommit:dword;

  cpgDiskCache:dword;

  cpgDiskCacheMac:dword;

  cpgDiskCacheMid:dword;

  cpgDiskCacheMin:dword;

  cpgfree:dword;

  cpglocked:dword;

  cpglockedNoncache:dword;

  cpgother:dword;

  cpgsharedpages:dword;

  cpgswap:dword;

  cpgswapfile:dword;

  cpgswapfiledefective:dword;

  cpgswapfileinuse:dword;

end;

type

  TSysInfo = class(TComponent)

  private

   fDialupAdapterInfo:TDialupAdapterInfo;

   fKernelInfo:TKernelInfo;

   fVCACHEInfo:TVCACHEInfo;

   fFATInfo:TFATInfo;

   fVMMInfo:TVMMInfo;

   ftimer:TTimer;

   fupdateinterval:integer;

   tmp:dword;

   vsize:dword;

   pkey:hkey;

   regtype:pdword;

   fstopped:boolean;

   procedure fupdatinginfo(sender:tobject);

   procedure fsetupdateinterval(aupdateinterval:integer);

  protected

   fsysInfoChanged:TNotifyEvent;

  public

   constructor Create(Aowner:Tcomponent);override;

   destructor  Destroy;override;

   property DialupAdapterInfo: TDialupAdapterInfo read fDialupAdapterInfo;

   property KernelInfo: TKernelInfo read fKernelInfo;

   property VCACHEInfo: TVCACHEInfo read fVCACHEInfo;

   property FATInfo: TFATInfo read fFATInfo;

   property VMMInfo: TVMMInfo read fVMMInfo;

   procedure StartRecievingInfo;

   procedure StopRecievingInfo;

  published

   property SysInfoChanged:TNotifyEvent read fsysInfoChanged write

    fsysInfoChanged;//Это событие вызывается после определённого интервала времени.

   property UpdateInterval:integer read fupdateInterval write

    fsetupdateinterval default 5000;

  end;

procedure TSysInfo.startrecievingInfo;

var

res:integer;

begin

res:=RegOpenKeyEx(HKEY_DYN_DATA,'PerfStats\StartStat',0,KEY_ALL_ACCESS,pkey);

if res<>0 then

  raise exception.Create('Could not open registry key');

fstopped:=false;

// Для Dial Up Адаптера

RegQueryValueEx(pkey,'Dial-Up Adapter\Alignment',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\Buffer',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\Framing',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\Overrun ',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\Timeout',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\CRC',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\Runts',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\FramesXmit',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\FramesRecvd',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\BytesXmit',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\BytesRecvd',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\TotalBytesXmit',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\TotalBytesRecvd',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\ConnectSpeed',nil,regtype,@tmp,@vsize);

// Для VCACHE

RegQueryValueEx(pkey,'VCACHE\LRUBuffers',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VCACHE\FailedRecycles',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VCACHE\RandomRecycles',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VCACHE\LRURecycles',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VCACHE\Misses',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VCACHE\Hits',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VCACHE\cMacPages',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VCACHE\cMinPages',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VCACHE\cCurPages',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'Dial-Up Adapter\BytesXmit',nil,regtype,@tmp,@vsize);

//Для VFAT

RegQueryValueEx(pkey,'VFAT\DirtyData',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VFAT\BReadsSec',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VFAT\BWritesSec',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VFAT\ReadsSec',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VFAT\WritesSec',nil,regtype,@tmp,@vsize);

//Для VMM

RegQueryValueEx(pkey,'VMM\cpgLockedNoncache',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgCommit',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgSharedPages',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgDiskcacheMid',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgDiskcacheMac',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgDiskcacheMin',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgDiskcache',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgSwapfileDefective',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgSwapfileInUse',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgSwapfile',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cDiscards',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cPageOuts',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cPageIns',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cInstanceFaults',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cPageFaults',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgOther',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgSwap',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgLocked',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'VMM\cpgFree',nil,regtype,@tmp,@vsize);

//Для KERNEL

RegQueryValueEx(pkey,'KERNEL\CPUUsage',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'KERNEL\VMs',nil,regtype,@tmp,@vsize);

RegQueryValueEx(pkey,'KERNEL\Threads',nil,regtype,@tmp,@vsize);

RegCloseKey(pkey);

ftimer.enabled:=true;

end;

destructor tsysinfo.Destroy;

begin

StopRecievingInfo;

ftimer.Destroy;

inherited;

end;

procedure Register;

begin

  RegisterComponents('Samples', [TSysInfo]);

end;

end.

// модуль диагностики процессора

unit example;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ProcessorClockCounter, StdCtrls;

type

  TForm1 = class(TForm)

    GroupBox1: TGroupBox;

    StaticText1: TStaticText;

    Button7: TButton;

    Button8: TButton;

    procedure pcc1PrecizeProc(Sender: TObject);

    procedure pcc2PrecizeProc(Sender: TObject);

    procedure pcc3PrecizeProc(Sender: TObject);

    procedure pcc4PrecizeProc(Sender: TObject);

    procedure pcc5PrecizeProc(Sender: TObject);

    procedure pcc7PrecizeProc(Sender: TObject);

    procedure pcc8PrecizeProc(Sender: TObject);

procedure Button7Click(Sender: TObject);

    procedure Button8Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

// Тактовая частота

procedure TForm1.pcc1PrecizeProc(Sender: TObject);

begin

sleep(1000);  //wait 1 s

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

button1.Caption:='Wait';

button1.Enabled:=false;

 pcc1.TestPrecizeProcInCache;

 label1.Caption:=IntToStr(pcc1.Counter)+' Hz';

button1.Caption:='Измерить тактовую частоту';

button1.Enabled:=true;

end;

// скорость выполнения арифметических операций

procedure TForm1.pcc2PrecizeProc(Sender: TObject);

var n:integer;

    m:integer;                // integer variable

begin

 for n:=0 to 99 do m:=m+1;

end;

procedure TForm1.pcc3PrecizeProc(Sender: TObject);

var n:integer;

    m:Int64;                  // Int64 variable

begin

 for n:=0 to 99 do m:=m+1;

end;

procedure TForm1.pcc4PrecizeProc(Sender: TObject);

var n:integer;

    m:single;                 // single type variable

begin

 for n:=0 to 99 do m:=m + 1.0001;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

 pcc2.TestPrecizeProcInCache;

 label2.Caption:=IntToStr(pcc2.Counter)+' тактов';

 pcc3.TestPrecizeProcInCache;

 label3.Caption:=IntToStr(pcc3.Counter)+' тактов';

 pcc4.TestPrecizeProcInCache;

 label4.Caption:=IntToStr(pcc4.Counter)+' тактов';

end;

// скорость системный шины

procedure TForm1.pcc5PrecizeProc(Sender: TObject);

begin

 asm

 nop; nop; nop; nop; nop; nop; nop; nop;

 nop; nop; nop; nop; nop; nop; nop; nop;

 nop; nop; nop; nop; nop; nop; nop; nop;

 nop; nop; nop; nop; nop; nop; nop; nop;

 nop; nop; nop; nop; nop; nop; nop; nop;

 nop; nop; nop; nop; nop; nop; nop; nop;

 nop; nop; nop; nop; nop; nop; nop; nop;

 nop; nop; nop; nop; nop; nop; nop; ret;

 end;

end;

procedure TForm1.Button3Click(Sender: TObject);

var cInRAM, cInCache:int64;

begin

 pcc5.TestPrecizeProc;        // Code is in RAM and will be pulled in cache

 cInRAM:=pcc5.Counter;

 label5.Caption:=IntToStr(cInRAM)+' тактов';

 pcc5.TestPrecizeProcInCache; // Code is already in cache

 cInCache:=pcc5.Counter;

 label6.Caption:=IntToStr(cInCache)+' тактов';

 label7.Caption:=IntToStr(cInRAM-cInCache)+ ' тактов';

end;

// скорость вызова приложений

procedure TForm1.Button4Click(Sender: TObject);

begin

 pcc6.Start;

 WinExec(PChar('Notepad.exe'),SW_SHOWNORMAL);

 pcc6.Stop;

label8.Caption:=IntToStr(pcc6.Counter)+' тактов';

end;

// Example 5

procedure TForm1.pcc7PrecizeProc(Sender: TObject);

begin

refresh;

end;

procedure TForm1.Button5Click(Sender: TObject);

begin

 pcc7.TestPrecizeProcInCache;

 label9.Caption:=IntToStr(pcc7.Counter)+ ' тактов';

end;

// скорость заполнения кэша

procedure TForm1.pcc8PrecizeProc(Sender: TObject);

begin

asm nop end;

end;

procedure TForm1.Button6Click(Sender: TObject);

begin

 pcc8.TestPrecizeProcInCache;

 label10.Caption:=IntToStr(pcc8.Counter)+ ' тактов';

end;

procedure TForm1.Button7Click(Sender: TObject);

begin

MessageDlg('NOP - Пустая операция'#13 +

'это псевдоним инструкции XCHG (E)AX, (E)AX',

mtInformation,[mbok],0);

end;

procedure TForm1.Button8Click(Sender: TObject);

begin

MessageDlg('процессор Pentium IV'#13 +

'с частотой системной шины 400 МГц',

mtInformation,[mbok],0);

end;

end.

Министерство Образования и Культуры

Кыргызской Республики

Кыргызский  Технический  Университет

им. И. Раззакова.

Кафедра Информатики и Вычислительной Техники

Выпускная Работа

на тему: _________________________________________________

Выполнил:    ст. гр. ЭВМ-1-99 

     Ыйсаев У.Б.

Принял(а): ______________________________

_________________________________________

Бишкек, 2003 г.