Опора деревянной одностоечной и способы укрепление угловых опор: Опоры ВЛ - конструкции, предназначенные для поддерживания проводов на необходимой высоте над землей, водой...
Семя – орган полового размножения и расселения растений: наружи у семян имеется плотный покров – кожура...
Топ:
Генеалогическое древо Султанов Османской империи: Османские правители, вначале, будучи еще бейлербеями Анатолии, женились на дочерях византийских императоров...
Характеристика АТП и сварочно-жестяницкого участка: Транспорт в настоящее время является одной из важнейших отраслей народного...
Интересное:
Как мы говорим и как мы слушаем: общение можно сравнить с огромным зонтиком, под которым скрыто все...
Инженерная защита территорий, зданий и сооружений от опасных геологических процессов: Изучение оползневых явлений, оценка устойчивости склонов и проектирование противооползневых сооружений — актуальнейшие задачи, стоящие перед отечественными...
Распространение рака на другие отдаленные от желудка органы: Характерных симптомов рака желудка не существует. Выраженные симптомы появляются, когда опухоль...
Дисциплины:
2019-08-04 | 133 |
5.00
из
|
Заказать работу |
Разработка алгоритма
В структурной схеме программы показаны основные взаимосвязи между отдельными модулями программы.
Глава 3. Эксплуатационная часть
Руководство программист a
В программе были применены, большое количество компонентов Windows, различные обработчик событий, процедуры и функции. При разработке программы было создано 3 модуля (Main, Diag, Example). В модуле Main былa примененa 1 процедурa.
Краткое описание основных использованных функций
Используем функцию GetComputerName для получения имени компьютера, функцию GetUserName для получения имени пользователя и функцию GetSystemInfo для получения информации о процессоре (наиболее полно данная функция реализована в Windows NT, где она возвращает и кол-во процессоров и их тип и т.д.).
Перейдем к параметрам экрану. Здесь мы будем использовать и Win32 API функции и стандартные объекты VCL. Так для получения разрешения экрана нам понадобится объект TScreen (его свойства Width и Height). Остальные параметры мы получим через контекст драйвера устройства DC используя функцию GetDeviceCaps.
Также будет интересна информация о памяти. Здесь нам поможет функция GlobalMemoryStatus, возвращающая информацию по объему физической и виртуальной памяти.
Узнаем информацию о ОС. Функция GetWindowsDirectory вернет путь к каталогу, где установлена система, функция GetSystemDirectory - к системному каталогу. Для определения версии ОС воспользуемся функцией GetVersionEx.
Опишем функцию BIOSInfo с параметром, характеризующем текущую ОС. Важно отметить, что способ получения информации о дате BIOS различен. Для NT получим информацию из реестра, а для Windows 95/98 из соответствующего участка памяти. Эти два способа взаимоисключаемы, так как у Windows 95/98 нет соответствующего раздела реестра, а прямой доступ к памяти в NT невозможен.
Рассмотрим функцию SystemParametersInfo, которая позволяет управлять некоторыми настройками системы. Область применения данной функции для NT и Windows 95/98 различна. Умышленно выберем некоторую общую часть для обеих систем.
Также можно позволить пользователю изменять и сохранять настройки системы по своему вкусу. Здесь можно использовать функцию SystemParametersInfo. Для компонентов tbKeyboardSpeed, tbKeyboardDelay, cbScreenSaverActive, cbSpeaker, edSSTimeOut в ObjectInspector перейдем на закладку Events и изменим событие OnChange (для tbKeyboardSpeed, tbKeyboardDelay), OnClick (для cbScreenSaverActive, cbSpeaker) и OnExit для edSSTimeOut на Change.
Использование Delphi совместно c фунциями Microsoft Win32 API позволит программисту создать более функционально богатые и гибкие приложения.
Процедуры модуля Main:
procedure TForm11.Timer1Timer(Sender: TObject);
Данная процедура используется для показа сплэш-окна при начальной загрузке программы. После своего выполнения она показывает главную форму.
Процедуры модуля Diag:
procedure TDiadnostic.AboutClick(Sender: TObject);
Процедура выполняет функцию открытия окна или формы. Это то же можно реализовать двумя способами:
1) Form1.Show;
2) Form1.Visible:=True;
procedure GetPrName(processor1:Tlabel);
Процедура определяет тип процессора.
procedure GetRegInfoWinNT;
Процедура используется для получения информации из реестра Windows. В частности, используется для выода информации о Базовой Системе Ввода-Вывода.
В большинстве случаев очень важной оказывается информация о типе BIOS. Строка типа BIOS хранится по адресу 0FFA68, а строка даты BIOS по адресу 0FFFF5. Это физические адреса, следовательно адреса "сегмент:смещение": 0F000:FA68 и 0F000:FFF5.
При включении компьютера BIOS инициализирует свои ресурсы и ищет, начиная с адреса 0C0000, ПЗУ установленных карт. Каждое ПЗУ имеет подпись, которая символизируется байтами 55AAh, если BIOS находит эти байты, то он узнаёт размер ПЗУ, который хранится в следующем байте и содержит число страниц по 512 байт, после чего по возможности считает контрольную сумму этого ПЗУ (она должна быть равна нулю) и передаёт управление на 4-ый байт. Также BIOS считает контрольную сумму байт CMOS, расположенных в ячейках 10h-2Dh. Так как в этих ячейках хранится важная, для продолжения работы, информация и её повреждения недопустимы.
Исходя из этого, программа определяет тип BIOS и считает контрольные суммы Видео ПЗУ и CMOS.
function GetDisplayDevice: string;
данная функция определяет основные параметры видеокарты, такие как размер памяти и строку данных производителя.
function LocalIP: string;
данная функция возвращает IP адрес текущего компьютера.
Function GetCPUSpeed: Double;
Выясняем тактовую частоту процессора.
function CheckDriveType(ch:char): String;
возвращает тип диска (сменный, жесткий)
procedure TDiadnostic.FormCreate(Sender: TObject);
создает главное окно программы
function getprintername:string;
Возвращает имя принтера, сетевого или локального.
procedure TDiadnostic.Button4Click(Sender: TObject);
выполняет обновление информации о состоянии памяти
procedure TDiadnostic.disknameChange(Sender: TObject);
выполняет смену имени диска
procedure TDiadnostic.FormClose(Sender: TObject; var Action: TCloseAction);
Процедура выполняет функцию выхода из программы. Мгновенный выход из программы.
Выход из программы можно организовать несколькими способами, такими как:
- Application.Terminate;
- Form1.Hide;
- Form1.Visible:=False;
- Form1.Close;
Эти команды практически не отличаются друг от друга. Единственным различием может быть то, что первый выход работает гораздо быстрее, т.е. приложение закрывается мгновенно.
function OpenCD(Drive: Char): Boolean;
выполняет функцию открытия сд-рома
function CloseCD(Drive: Char): Boolean;
выполняет функцию закрытия сд-рома.
procedure TDiadnostic.SpeedButton1Click(Sender: TObject);
Процедура выполняет функцию открытия окна или формы. В данном случае открывается окно тестирования процессора.
Процедуры модуля Example:
procedure TForm1.Button1Click(Sender: TObject);
выполняет измерение тактовой частоты процессора.
Следует подробнее рассказать об идентификации процессора. Как известно, в процессорах пятого поколения, а также в некоторых четвёртого поколения, появилась команда CPUID. Эта команда позволяет больше узнать об установленном в системе процессоре. Обмен информацией происходит через основные регистры (EAX, EBX, ECX, EDX). Параметры задаются через регистр EAX. Таким образом, чтобы узнать информацию о версии процессора, я записал в EAX 1 и вызвал CPUID, после чего в EAX хранился результат. Для того, чтобы узнать производителя процессора, я записал в EAX 0 и вызвал CPUID, после чего в основных регистрах находится, уникальная для каждого производителя, строка. Для AMD это "AuthenticAMD", для Intel - "GenuineIntel", для Cyrix - "CyrixInstead". Теперь расскажу об идентификации процессоров, не имеющих инструкции CPUID. Понятно, что столь подробную информацию, в этом случае получить невозможно. Т.к. программа требует процессор не ниже третьего поколения, я начал проверку именно с этого поколения. Наличие 386-го процессора определяется недоступностью для записи 18-го бита регистра флагов, если бит доступен для записи, то я проверяю наличие поддержки команды CPUID, если она не поддерживается, то процессор 486-ой. Если же CPUID поддерживается, то дальше всё определение ложится именно на эту команду.
Наличие поддержки команды CPUID определяется доступностью для записи 21-го бита регистра флагов.
procedure TForm1.pcc2PrecizeProc(Sender: TObject);
используется для тестирования скорости выполнения арифметических операций, а именно для вычисления времени сложения 100 целых чисел.
procedure TForm1.pcc3PrecizeProc(Sender: TObject);
используется для вычисления времени сложения 100 целых 64-битных чисел.
procedure TForm1.pcc4PrecizeProc(Sender: TObject);
используется для сложения 100 вещественных чисел
procedure TForm1.Button2Click(Sender: TObject);
собственно выполняет 3 вышеперечисленных процедуры
procedure TForm1.pcc5PrecizeProc(Sender: TObject);
используется для тестирования скорости системной шины
procedure TForm1.Button3Click(Sender: TObject);
при нажатии данной кнопки процессор последовательно производит вычисления над 64-мя операциями NOP, расположенными в первом случае в памчти, во втором- в кэше, и потом вычисляет задержку на передачу команд из памяти.
procedure TForm1.Button4Click(Sender: TObject);
используется для тестирования скорости вызова приложения в оперативную память (вызывается блокнот).
procedure TForm1.pcc7PrecizeProc(Sender: TObject);
здесь тестируется скорость заполнения кэша
procedure TForm1.pcc8PrecizeProc(Sender: TObject);
выясняем количество тактов, необходимых для выполнения одной операции NOP
NOP - Пустая операция.
---------------------------------------------------------
O D I T S Z A P C
----------------------------------------------------------------
¦Код Инструкция Такты Описание ¦
¦операции ¦
+--------T---------T-----T-----T-----T------T-------------------+
¦ ¦ ¦486 ¦386 ¦286 ¦86 ¦ ¦
+--------+---------+-----+-----+-----+------+-------------------+
¦90 ¦NOP ¦1 ¦3 ¦3 ¦3 ¦Нет операции. ¦
L--------+---------+-----+-----+-----+------+--------------------
Операция NOP не выполняет никакой операции. NOP - это одно-
байтовая инструкция, которая занимает место, но но не влияет на
содержимое машины (кроме (E)IP).
NOP - это псевдоним инструкции XCHG (E)AX, (E)AX.
procedure TProcessorClockCounter.TestPrecizeProc;
данная процедура помещает небольшой код в кэш память
procedure TProcessorClockCounter.TestPrecizeProcInCache;
данная процедура тестирует кусок кода, уже находящийся в кэш-памяти
procedure TDiadnostic.SpeedButton2Click(Sender: TObject);
данная процедура высвечивает сообщение о том, что программа тестирования памяти загружена в оперативную память.
Тестированию подвергается память, расположенная выше первого мегабайта, во избежание проблем. Программа использует три разновидности тестирования: Бегущая Единица, Бегущий Ноль, Шахматная доска. Перед тем как начать тестирование, программа определяет объём памяти, установленной в системе. Для этого в последние четыре байта, каждого мегабайта, записывается число, затем оно читается и сравнивается. Если оно не совпадает с записанным, значит этого и последующих мегабайт памяти не существует.
Особенности применяемых тестов следующие. Тест "Бегущая Единица" или "Бегущий Ноль" состоит в том, что в каждый байт памяти записывается значение 0FFh или 0 соответственно, затем это значение сравнивается. Несовпадение говорит об ошибке. В тесте "Шахматная доска" в память записываются значения вида 10101010b, затем они сдвигаются и сравниваются. Несовпадение - ошибка.
Руководство пользователю
Программа функционирует по следующему принципу:
после этого появляется главное окно программы
в нем содержатся следующие закладки:
1. Общие – общая информация, т.е. тип процессора, операционная система, версия ОС, имя пользователя, организация.
2. Диски – информация о всех дисках, установленных в системе, таких как жесткие диски, СД-РОМ, флоппи-диски, а также информация об их емкости, метке
тома, и файловой системе.
3.
Принтер – информация о принтерах, установленных в системе
4. память – информация о системной памяти, о ее количестве, информация о файле подкачки.
5.
Клавиатура и мышь – информация о установленных в системе клавиатуре и мыши.
6.
Видео- информация о видеокарте, разрешении монитора, поставщике драйвера и т.д.
7.
информация о процессоре – вендор, частота
8.
шрифты – информация о установленных шрифтах.
9.
Диагностика – здесь собраны такие свойства, как тестирование процессора, памяти и проверка лотка СД-рома, а также информация об авторе этой маленькой программы
10.
здесь, можно потестировать очень много параметров. Перечислим наиболее главные из них:
-тактовая частота – здесь применяется встроенный в микропроцессор счетчик тактов, с которого мы получаем текущую тактовую частоту
-скорость выполнения арифмеических операций – здесь мы тестируем, насколько быстро процессор выполняет основные арифметические операции с различными типами данных
-скорость системной шины – здесь мы проверяем скорость шины между процессором и памятью, т.е. за сколько тактов передается информация между ними. Используется инструкции НОП, расположенные в первом случае в оперативной памяти, а во вотром случае – в кэш-памяти.
В конце программа вычисляет задержку памяти, т.е. сколько тактов требуется именно на передачу данных из / в память.
-скорость вызова приложений – здесь тестируем, за сколько тактов вызывается в оперативнюу память стандартная программа Блокнот
-скорость заполнения кэша – тама мы заполняем все 256 или 512 килобайтов кэша инструкциями, и смотрим, за сколько тактов он заполнится.
Заключение
Известно, что выпускная работа завершает подготовку бакалавра и показывает готовность выпускника решать теоретические и практические задачи в условиях реальной трудовой деятельности.
Цель выпускной работы – систематизация и углубление теоретических и практических знаний студента по специальности и возможности их применения в конкретных условиях практической деятельности. Поэтому то, как студент выполнил выпускную работу, показывает, как он подготовлен.
В данной выпускной работе мною рассмотрена программа диагностики и тестирования компьютера, и в процессе ее написания я более хорошо понял назначение и принцип работы основных устройств персонального компьютера. Вышеозначенные знания, несомненно, пригодятся мне в дальнейшей моей трудовой деятельности. Я очень благодарен преподавательскому составу нашей кафедры за привитую мне способность учиться, невзирая на лень и другие обстоятельства.
Что касается социальной(общественной ценности) данной работы, то я уверен, что для меня она очень значима, так как в процессе разработки я научился терпимости по отношению к программам и вообще у меня получилась очень хорошая утилитка.
Список используемой литературы
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 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
Архитектура электронного правительства: Единая архитектура – это методологический подход при создании системы управления государства, который строится...
Двойное оплодотворение у цветковых растений: Оплодотворение - это процесс слияния мужской и женской половых клеток с образованием зиготы...
Механическое удерживание земляных масс: Механическое удерживание земляных масс на склоне обеспечивают контрфорсными сооружениями различных конструкций...
Общие условия выбора системы дренажа: Система дренажа выбирается в зависимости от характера защищаемого...
© cyberpedia.su 2017-2024 - Не является автором материалов. Исключительное право сохранено за автором текста.
Если вы не хотите, чтобы данный материал был у нас на сайте, перейдите по ссылке: Нарушение авторских прав. Мы поможем в написании вашей работы!