Быстрый поиск

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

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;

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;

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;

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;

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;

Calibrate;

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;

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;

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

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

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

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

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

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

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

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; ret;

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 г.

Страницы: 1, 2, 3, 4

Меню

Быстрый поиск

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

Новости

Быстрый поиск

Группа вКонтакте: новости

Новости в Twitter и Facebook

Новости

Обратная связь