{

	Created by ENTER
	Icq - 555555560
	Mail - enter222@rambler.ru

}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Func, WinSock, PSAPI, TlHelp32, math, SysInfo,  Registry, ComCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  public
    procedure get_wnd;
    procedure get_prc;
    procedure get_prc2;
    procedure get_mem;
    procedure get_sys;
    procedure fld;
    procedure hrd;
    procedure find_hrd;
    procedure get_prog;
    procedure get_users;
    procedure get_ip;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
   USER_INFO_1 = record
     usri1_name: LPWSTR;
     usri1_password: LPWSTR;
     usri1_password_age: DWORD;
     usri1_priv: DWORD;
     usri1_home_dir: LPWSTR;
     usri1_comment: LPWSTR;
     usri1_flags: DWORD;
     usri1_script_path: LPWSTR;
   end;
   lpUSER_INFO_1 = ^USER_INFO_1;

function NetUserEnum(ServerName: PWideChar;
   Level,
   Filter: DWORD;
   var Buffer: Pointer;
   PrefMaxLen: DWORD;
   var EntriesRead,
   TotalEntries,
   ResumeHandle: DWORD): Longword; stdcall; external 'netapi32.dll';

 function NetApiBufferFree(pBuffer: PByte): Longint; stdcall; external
 'netapi32.dll';

function BytesToText(Bytes : integer) : String;
begin

  if Bytes div 1000 < 1 then Result := IntToStr(Bytes) + ' байт';
  if Bytes div 1000 >= 1 then Result := FloatToStrF(Bytes/1000, ffNumber, 18, 1) + ' Кб';
  if Bytes div 1000 >= 1000 then Result := FloatToStrF(Bytes/1000000, ffNumber, 18, 1) + ' Мб';

end;

function true_size(sizeb :integer) :string;
var
   output:real;
   types:string;
begin
   if sizeb < 1024 then begin
      output:=sizeb;
      types:='byte';
   end
   else if sizeb < 1048576 then begin
      output:=roundto((sizeb/1024),-2);
      types:='kb';
   end
   else if sizeb < 1073741824 then begin
      output:=roundto(((sizeb/1024)/1024),-2);
      types:='mb';
   end
   else if sizeb < 1099511627776 then begin
      output:=roundto((((sizeb/1024)/1024)/1024),-2);
      types:='gb';
   end
   else begin
      output:=roundto(((((sizeb/1024)/1024)/1024)/1024),-2);
      types:='tb';
   end;
   Result:=floattostr(output)+types;
end;

procedure Tform1.get_wnd;
var
  Wnd : hWnd;
  buff: array [0..127] of Char;
begin
  Wnd := GetWindow(Handle, gw_HWndFirst);
  while Wnd <> 0 do begin
    if (Wnd <> Application.Handle) and
       IsWindowVisible(Wnd) and
       (GetWindow(Wnd, gw_Owner) = 0) and
       (GetWindowText(Wnd, buff, sizeof(buff)) <> 0)
    then begin
      GetWindowText(Wnd, buff, sizeof(buff));
      memo1.Lines.Add(StrPas(buff));
    end;
    Wnd := GetWindow(Wnd, gw_hWndNext);
  end;
end;

procedure Tform1.get_prc;
var
   handler:thandle;
   data:TProcessEntry32;
   function return_name:string;
   var
      i:byte;
      names:string;
   begin
      names:='';
      i:=0;
      while data.szExeFile[i] <> '' do
      begin
         names:=names+data.szExeFile[i];
         inc(i);
      end;
      return_name:=names;
   end;
   begin
      handler:=createtoolhelp32snapshot(TH32CS_SNAPALL,0);
      if process32first(handler,data) then begin
      memo1.Lines.Add(return_name);
      while process32next(handler,data) do
         memo1.Lines.Add(return_name);
      end else memo1.Lines.Add('Ошибка получения информации');
end;

procedure TForm1.get_mem;
var
   MemoryStatus: TMemoryStatus;
begin
   MemoryStatus.dwLength := SizeOf(MemoryStatus) ;
   GlobalMemoryStatus(MemoryStatus) ;
   with MemoryStatus do
   begin
      Memo1.Lines.Add(IntToStr(dwMemoryLoad) + '% использованно памяти') ;
      Memo1.Lines.Add(true_size(dwTotalPhys) +' - Всего физической памяти') ;
      Memo1.Lines.Add(true_size(dwAvailPhys) +' - Доступно физической памяти') ;
      Memo1.Lines.Add(inttostr(dwTotalPageFile) +' - Всего виртуальной памяти') ;
      Memo1.Lines.Add(true_size(dwAvailPageFile) +' - Доступно виртуальной памяти (байт)') ;
      Memo1.Lines.Add(true_size(dwTotalVirtual) +' - Адресное виртуальное простанство текущего процесса') ;
      Memo1.Lines.Add(true_size(dwAvailVirtual) +' - Доступное виртуальное адресное пространство текущего процесса') ;
   end;
end;

procedure TForm1.get_sys;
var
   MajVer:Byte;
   MinVer:Byte;
   BuildNo: Word;
   Plat: String;
begin
   Plat:= GetPlatform;
   GetOS(MajVer, MinVer, BuildNo);
   memo1.Lines.Add('Build OS: '+IntToStr(BuildNo));
   memo1.Lines.Add(GetOSBrief);
   memo1.Lines.Add('Platform: '+Plat);
end;

procedure TForm1.fld;
begin
   memo1.Lines.Add('Win Dir: '+GetWindowsDir);
   memo1.Lines.Add('Sys Dir: '+GetSystemDir);
   memo1.Lines.Add('Current Dir: '+GetCurrentDir);
end;

procedure TForm1.hrd;
begin
   memo1.Lines.Add('Processor Level: '+GetProcessorLevel);
   memo1.Lines.Add('CPU: '+FloatToStr(GetCPUSpeed)+' MHz');
   memo1.Lines.Add('Drive A: '+GetDrive('A:'));
   memo1.Lines.Add('Drive B: '+GetDrive('B:'));
   memo1.Lines.Add('Drive C: '+GetDrive('C:'));
   memo1.Lines.Add('Drive D: '+GetDrive('D:'));
   memo1.Lines.Add('Drive E: '+GetDrive('E:'));
   memo1.Lines.Add('Drive F: '+GetDrive('F:'));
   memo1.Lines.Add('Drive G: '+GetDrive('G:'));
   memo1.Lines.Add('Computer Name: '+GetCompName);
   memo1.Lines.Add('KeyBoard Language: '+GetKeyBoardLanguage);
   memo1.Lines.Add('Video Card: '+GetVideoCard);
end;

procedure TForm1.get_prc2;
var
   Proc: TProcArray;
   k,I: Integer;
begin
   if GetPlatform = 'WinNT' then k:=GetProcessesWinNT(Proc) else
   if GetPlatform = 'Win95' then k:=GetProcessesWin95(Proc) else
   exit;
   memo1.Lines.Add('Запущено процессов: '+IntToStr(k));
   for I:=0 to K-1 do Memo1.Lines.Add(Proc[I]);
end;

function DriveExists(Drive: Byte): boolean;
begin
  Result := Boolean(GetLogicalDrives and (1 shl Drive));
end;

 function GetDiskSize(drive: Char; var free_size, total_size: Int64): Boolean;
 var
   RootPath: array[0..4] of Char;
   RootPtr: PChar;
   current_dir: string;
 begin
   RootPath[0] := Drive;
   RootPath[1] := ':';
   RootPath[2] := '\';
   RootPath[3] := #0;
   RootPtr := RootPath;
   current_dir := GetCurrentDir;
   if SetCurrentDir(drive + ':\') then
   begin
     GetDiskFreeSpaceEx(RootPtr, Free_size, Total_size, nil);
    SetCurrentDir(current_dir);
     Result := True;
   end
   else
   begin
     Result := False;
     Free_size  := -1;
     Total_size := -1;
   end;
 end;

procedure TForm1.find_hrd;
var
   Drive: byte;
   free_size, total_size: Int64;
begin
   for Drive := 0 to 25 do
   if DriveExists(Drive)
   then begin
      if (GetDiskSize(Chr(Drive + $41), free_size, total_size))
      then begin
         memo1.Lines.Add(Chr(Drive + $41)
         + ': - ' +'Свободно ' +BytesToText(free_size)
         +' Обьем ' +BytesToText(total_size));
      end
      else begin
      memo1.Lines.Add(Chr(Drive + $41)+
      ': - Свободно Не определено Обьем Не определено');
      end
   end;
end;

procedure Tform1.get_prog;
var
   MyList: TStringList;
   MyRegistry: TRegistry;
   i: Integer;
   Str: string;
begin
   MyRegistry:=TRegistry.Create;
   MyList:=TStringList.Create;
   with MyRegistry do
   begin
      RootKey:=HKEY_LOCAL_MACHINE;
      if OpenKey('Software\Microsoft\Windows\CurrentVersion\Uninstall',False)=True then GetKeyNames(MyList);
      CloseKey;
      for i:=0 to MyList.Count-1 do
      begin
         RootKey:=HKEY_LOCAL_MACHINE;
         OpenKey('Software\Microsoft\Windows\CurrentVersion\Uninstall\'+MyList[i], False);
         Str:=ReadString('DisplayName');
         if Str<>'' then
         Memo1.Lines.Add(ReadString('DisplayName'));
         CloseKey;
      end;
   end;
end;

procedure TForm1.get_users;
var
   EntiesRead: DWORD;
   TotalEntries: DWORD;
   UserInfo: lpUSER_INFO_1;
   lpBuffer: Pointer;
   ResumeHandle: DWORD;
   Counter: Integer;
   NetApiStatus: LongWord;
begin
   ResumeHandle := 0;
   repeat
   NetApiStatus := NetUserEnum(nil, 1, 0, lpBuffer, 0, EntiesRead,TotalEntries, ResumeHandle);
   UserInfo     := lpBuffer;
   for Counter := 0 to EntiesRead - 1 do
   begin
      Memo1.Lines.Add(WideCharToString(UserInfo^.usri1_name) + ' --> ' +
      WideCharToString(UserInfo^.usri1_comment));
      Inc(UserInfo);
   end;
   NetApiBufferFree(lpBuffer);
   until (NetApiStatus <> ERROR_MORE_DATA);
end;

procedure TForm1.get_ip;
type
  InAddr = Array[0..10] of PInAddr;
  TInAddr = ^InAddr;
var
  Host: PHostEnt;
  pPtr: TInAddr;
  Buffer: Array[0..63] of char;
  i: Integer;
  Socket: TWSAData;
begin
   WSAStartup( $101, Socket );
   GetHostName( Buffer, SizeOf( Buffer ) );
   Host := GetHostByName( buffer );
   if Host = nil then Exit;
   pPtr := TInAddr( Host^.h_addr_list );
   i := 0;
   while pPtr^[i] <> nil do
   begin
      memo1.Lines.Add( inet_ntoa( pPtr^[i]^ ) );
      Inc( i );
   end;
   WSACleanup;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   memo1.Lines.Add('---Список открытых окон---'+#13#10);
   get_wnd;
   memo1.Lines.Add(#13#10+'---Список открытых процессов---'+#13#10);
   get_prc;
   memo1.Lines.Add(#13#10+'---Память---'+#13#10);
   get_mem;
   memo1.Lines.Add(#13#10+'---Система---'+#13#10);
   get_sys;
   memo1.Lines.Add(#13#10+'---Каталоги---'+#13#10);
   fld;
   memo1.Lines.Add(#13#10+'---Железо---'+#13#10);
   hrd;
   memo1.Lines.Add(#13#10+'---Список открытых процессов 2---'+#13#10);
   get_prc2;
   memo1.Lines.Add(#13#10+'---Жесткие диски---'+#13#10);
   find_hrd;
   memo1.Lines.Add(#13#10+'---Список установленных программ---'+#13#10);
   get_prog;
   memo1.Lines.Add(#13#10+'---Список пользователей---'+#13#10);
   get_users;
   memo1.Lines.Add(#13#10+'---Список ip адресов---'+#13#10);
   get_ip;
end;

end.
