kursovaya / Unit4

unit Unit4;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Winsock, registry, ExtCtrls, StdCtrls, ImgList, Buttons, ShellAPI, ComCtrls;

type
TForm4 = class(TForm)
Image1: TImage;
Timer1: TTimer;
StatusBar1: TStatusBar;
ImageList1: TImageList;
Image2: TImage;
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Image2Click(Sender: TObject);
private
{ Private declarations }
public
procedure info(s1, s2: string);
end;

var
Form4: TForm4;
gn_speed_y: Integer;
gn_text_y: Integer;
_eax, _ebx, _ecx, _edx: Longword;
i: Integer;
b: Byte;
b1: Word;
s,s1,s2,s3,s_all:string;
q:TImageIndex;
lpDisplayDevice: TDisplayDevice;
dwFlags: DWORD;
cc: DWORD;
const
gn_speed_x: Integer =8;
gn_text_x: Integer =15;
gl_start: Boolean =True;
implementation

{$R *.dfm}



procedure TForm4.FormShow(Sender: TObject);
var
_eax, _ebx, _ecx, _edx: Longword;
i: Integer;
b: Byte;
s, s1, s2, s3, s_all: string;
MS:TMemoryStatus;
wVerReq: WORD;
wsaData: TWSAData;
iw: pchar;
h: PHostEnt;
c: array[0..128] of char;
isa:integer;
ld:DWORD;
PathArray : array [0..255] of char;
OSVersion:TOSVersionInfo;
begin
info('','');
//Set the startup colour of the image
Image1.Canvas.Brush.Color:=clBtnFace;
Image1.Canvas.FillRect(rect(0, 0, Image1.Width,Image1.Height));
begin
asm //get brand ID
mov eax,$80000002
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3:= s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
s_all := s3 + s + s1 + s2;
asm
mov eax,$80000003
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3 := s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
s_all := s_all + s3 + s + s1 + s2;

asm
mov eax,$80000004
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3 := s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);
info('', 'Процессор - ' + s_all + s3 + s + s1 + s2);
end;

lpDisplayDevice.cb := sizeof(lpDisplayDevice);
while EnumDisplayDevices(nil, cc, lpDisplayDevice, dwFlags) do
begin
Inc(cc);
begin
info('', 'Видео карта - ' + lpDisplayDevice.DeviceString);
end
end;
begin
GlobalMemoryStatus(MS);
begin
info('', 'Оперативня память - '+FormatFloat('#,###" Мгб"', MS.dwTotalPhys / 1044484) );
end
end;
begin
OSVersion.dwOSVersionInfoSize := SizeOf(OSVersion);
if GetVersionEx(OSVersion) then
info('', 'Версия операционной системы - ' + Format('%d.%d (%d.%s)',[OSVersion.dwMajorVersion,OSVersion.dwMinorVersion,(OSVersion.dwBuildNumber and $FFFF),OSVersion.szCSDVersion]));
end;

begin
ld:=GetLogicalDrives;
for isa:=0 to 25 do
begin
if (ld and (1 shl isa))<>0 then
if GetDriveType(PChar(Char(Ord('A')+isa) + ':\'))=DRIVE_FIXED then
info('','HDD - ' +Char(Ord('A')+isa)+':\');
if GetDriveType(PChar(Char(Ord('A')+isa) + ':\'))=DRIVE_REMOVABLE then
info('','Floppy - '+Char(Ord('A')+isa)+':\');
if GetDriveType(PChar(Char(Ord('A')+isa)+':\'))=DRIVE_CDROM then
info('','CD-Rom - '+Char(Ord('A')+isa)+':\');
end;
begin
wVerReq:=MAKEWORD(1,1);
WSAStartup(wVerReq,wsaData);

GetHostName(@c,128);
h:=GetHostByName(@c);
iw:=iNet_ntoa(PInAddr(h^.h_addr_list^)^);

WSACleanup;
begin
info('','IP - '+iw);

end;
begin
info('','HOST - '+h^.h_Name);

end;
end;
begin
FillChar(PathArray,SizeOf(PathArray),#0);
GetWindowsDirectory(PathArray,255);
info('','Дериктория Windows - '+Format('%s',[PathArray]));
end;
end;
end;

procedure TForm4.info(s1, s2: string);
begin
if s1 <> '' then
begin
Image1.Canvas.Brush.Color := clBtnFace;
Image1.Canvas.Font.Color := clBlack;
Image1.Canvas.TextOut(gn_text_x, gn_text_y, s1);
end;
if s2 <> '' then
begin
Image1.Canvas.Brush.Color := clBtnFace;
Image1.Canvas.Font.Color := clBlack;
Image1.Canvas.TextOut(gn_text_x + Image1.Canvas.TextWidth(s1), gn_text_y, s2);
end;
Inc(gn_text_y, 13);
end;



procedure TForm4.Timer1Timer(Sender: TObject);
begin
StatusBar1.Panels[0].Text:='Сейчас: '+DateToStr(Now)+' '+TimeToStr(Now);
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
Form4.Left:=(Screen.Width-Form4.Width) div 2; //по середине моннитора
Form4.Top:=(Screen.Height-Form4.Height) div 2;
end;

procedure TForm4.FormActivate(Sender: TObject);
const
n=127;
var
i:Byte;
begin
AlphaBlend:=True;
for i:=1 to n do
begin
AlphaBlendValue:=i*2;
Repaint;
end;
end;

procedure TForm4.Image2Click(Sender: TObject);
var
reestr : TRegistry;
begin
reestr:=TRegistry.Create;
reestr.RootKey := HKEY_CURRENT_USER;
Reestr.OpenKey('SOFTWARE\MICROSOFT\Internet Explorer\Main',True);
close;
end;

end.