Реферат: Утилита диагностики компьютера
{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;
Страницы: 1, 2, 3, 4, 5, 6, 7, 8
