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

конкретных условиях практической деятельности. Поэтому то, как студент

выполнил выпускную работу, показывает, как он подготовлен.

В данной выпускной работе мною рассмотрена программа диагностики и

тестирования компьютера, и в процессе ее написания я более хорошо понял

назначение и принцип работы основных устройств персонального компьютера.

Вышеозначенные знания, несомненно, пригодятся мне в дальнейшей моей

трудовой деятельности. Я очень благодарен преподавательскому составу нашей

кафедры за привитую мне способность учиться, невзирая на лень и другие

обстоятельства.

Что касается социальной(общественной ценности) данной работы, то я

уверен, что для меня она очень значима, так как в процессе разработки я

научился терпимости по отношению к программам и вообще у меня получилась

очень хорошая утилитка.

Список используемой литературы

1) С. Бобровский “DELPHI 5” Учебный курс Москва 2000г.

2) Справочник функций WinAPI.

Приложение 1 Листинг программы

// главный модуль

unit Main;

interface

uses

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

Forms,

Dialogs, StdCtrls, jpeg, ExtCtrls;

type

TForm11 = class(TForm)

Image1: TImage;

Timer1: TTimer;

Label1: TLabel;

procedure Timer1Timer(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form11: TForm11;

implementation

uses Diag;

{$R *.dfm}

procedure TForm11.Timer1Timer(Sender: TObject);

begin

diadnostic.show;

timer1.Enabled:=false;

end;

end.

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

unit Diag;

interface

uses

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

StdCtrls, ComCtrls, Registry,Printers, ExtCtrls, AxCtrls, OleCtrls, vcf1,

Tabs, Winspool,

FileCtrl, ImgList, Menus,winsock,ScktComp, Systeminfo,mmsystem,

Buttons,shellapi;

type

TDiadnostic = class(TForm)

SysInfo1: TSysInfo;

Timer1: TTimer;

Button1: TButton;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton;

GroupBox3: TGroupBox;

About: TButton;

procedure AboutClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure aClick(Sender: TObject);

procedure disknameClick(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure disknameChange(Sender: TObject);

procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;

var Height: Integer);

procedure ListBox1Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure Timer1Timer(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure SpeedButton1Click(Sender: TObject);

procedure SpeedButton2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Diadnostic: TDiadnostic;

implementation

uses tlhelp32, about, example;

{$R *.DFM}

function GetRootDir:string; external 'Ulandll.dll' index 1;

function getboottype:string; external 'UlanDll.dll';// index 31;

procedure TDiadnostic.AboutClick(Sender: TObject);

begin

form2.show;

end;

procedure GetPrName(processor1:Tlabel);

var SI:TsystemInfo;

begin

GetSystemInfo(SI);

Case SI.dwProcessorType of

386:Processor1.caption:='386';

486:Processor1.caption:='486';

586:Processor1.caption:='586';

686:Processor1.caption:='686';

end;

end;

procedure GetRegInfoWinNT;

var

Registryv : TRegistry;

RegPath : string;

sl,sll : TStrings;

begin

RegPath := '\HARDWARE\DESCRIPTION\System';

registryv:=tregistry.Create;

registryv.rootkey:=HKEY_LOCAL_MACHINE;

sl := nil;

try

registryv.Openkey(RegPath,false);

diadnostic.Label28.Caption:=(RegistryV.ReadString('SystemBiosDate'));

sl:= ReadMultirowKey(RegistryV,'SystemBiosVersion');

diadnostic.memo1.Text:=sl.Text;

except

end;

Registryv.Free;

if Assigned(sl) then sl.Free;

end;

function GetDisplayDevice: string;

var

lpDisplayDevice: TDisplayDevice;

begin

lpDisplayDevice.cb := sizeof(lpDisplayDevice);

EnumDisplayDevices(nil, 0, lpDisplayDevice , 0);

Result:=lpDisplayDevice.DeviceString;

end;

procedure getinfovideo;

var

lpDisplayDevice: TDisplayDevice;

dwFlags: DWORD;

cc: DWORD;

begin

diadnostic.memo2.Clear;

lpDisplayDevice.cb := sizeof(lpDisplayDevice);

dwFlags := 0;

cc:= 0;

while EnumDisplayDevices(nil, cc, lpDisplayDevice , dwFlags) do

begin

Inc(cc);

diadnostic.memo2.lines.add(lpDisplayDevice.DeviceString);

{Так же мы увидим дополнительную информацию в lpDisplayDevice}

end;

end;

function LocalIP : string;

type

TaPInAddr = array [0..10] of PInAddr;

PaPInAddr = ^TaPInAddr;

var

phe : PHostEnt;

pptr : PaPInAddr;

Buffer : array [0..63] of char;

I : Integer;

GInitData : TWSADATA;

begin

WSAStartup($101, GInitData);

Result := '';

GetHostName(Buffer, SizeOf(Buffer));

phe :=GetHostByName(buffer);

if phe = nil then Exit;

pptr := PaPInAddr(Phe^.h_addr_list);

I := 0;

while pptr^[I] <> nil do begin

result:=StrPas(inet_ntoa(pptr^[I]^));

Inc(I);

end;

WSACleanup;

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;

function CheckDriveType(ch:char): String;

var

DriveLetter: Char;

DriveType : UInt;

begin

DriveLetter := Ch;

DriveType := GetDriveType(PChar(DriveLetter + ':\'));

Case DriveType Of

0: Result := '?';

1: Result := 'Path does not exists';

Drive_Removable: Result := 'Removable';

Drive_Fixed : Result := 'Fixed';

Drive_Remote : Result := 'Remote';

Drive_CDROM : Result := 'CD-ROM';

Drive_RamDisk : Result := 'RAMDisk'

else

Result := 'Unknown';

end;

end;

function GettingHWProfileName: String;

var

pInfo: TagHW_PROFILE_INFOA;

begin

GetCurrentHwProfile(pInfo);

Result := pInfo.szHwProfileName;

end;

procedure TDiadnostic.FormCreate(Sender: TObject);

var OsVerInfo:Tosversioninfo;

winver,build:string;

Disks:byte;

buffer:array[0..255]of char;

wd:string;

sp:array[0..max_path-1]of char;

s:string;

memorystatus:tmemorystatus;

dwLength:DWORD; // sizeof(MEMORYSTATUS)

dwMemoryLoad:DWORD; // percent of memory in use

dwTotalPhys:DWORD ; // bytes of physical memory

dwAvailPhys:DWORD ; // free physical memory bytes

dwTotalPageFile:DWORD ; // bytes of paging file

dwAvailPageFile:DWORD ;// free bytes of paging file

dwTotalVirtual:DWORD ;// user bytes of address space

dwAvailVirtual:DWORD ; // free user bytes

ktype:integer;

R:Tregistry;

R2:Tregistry;

disk1:integer;

msgtext:string;

const

monitorregdir:string='\system\currentcontrolset\ENUM\Display\Default_Monitor

';

videordir:string='\System\currentcontrolset\services\class\display\0000';

processordir:string='Hardware\Description\System\Centralprocessor\0';

begin

button2.click;

Label50.Caption:=GettingHWProfileName;

listbox1.items:=screen.fonts;

numofbuttons.caption:=inttostr(getsystemmetrics(sm_cmousebuttons));

if getsystemmetrics(sm_mousepresent)<>0then ismouse.caption:='Есть'else

ismouse.caption:='Нет';

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

begin

disk.lines.add(diskname.items[disk1]+'

'+CheckDriveType(diskname.items[disk1][1]));

end;

{monitor&video}

///////

R:=tregistry.create;

R.RootKey:=HKEY_LOCAL_MACHINE;

R.OpenKey(monitorregdir,false);

monitortype.caption:=R.ReadString('DeviceDesc');

monitormanufacturer.caption:=R.ReadString('Mfg');

monitorid.caption:=r.readstring('HardwareID');

R.OpenKey(videordir,false);

//drvdesc.caption:=r.ReadString('DriverDesc');

driverdate.caption:=r.readstring('DriverDate');

drvprovider.caption:=r.readstring('ProviderName');

driverver.caption:=r.readstring('ver');

r.closekey;

r.closekey;

getinfovideo;

//////

{Version BIOS}

GetRegInfoWinNT;

{advanced processor info}

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

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