Утилита диагностики компьютера
конкретных условиях практической деятельности. Поэтому то, как студент
выполнил выпускную работу, показывает, как он подготовлен.
В данной выпускной работе мною рассмотрена программа диагностики и
тестирования компьютера, и в процессе ее написания я более хорошо понял
назначение и принцип работы основных устройств персонального компьютера.
Вышеозначенные знания, несомненно, пригодятся мне в дальнейшей моей
трудовой деятельности. Я очень благодарен преподавательскому составу нашей
кафедры за привитую мне способность учиться, невзирая на лень и другие
обстоятельства.
Что касается социальной(общественной ценности) данной работы, то я
уверен, что для меня она очень значима, так как в процессе разработки я
научился терпимости по отношению к программам и вообще у меня получилась
очень хорошая утилитка.
Список используемой литературы
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
|