Что касается социальной(общественной ценности) данной работы, то я уверен, что для меня она очень значима, так как в процессе разработки я научился терпимости по отношению к программам и вообще у меня получилась очень хорошая утилитка.

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

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