unit SysInfo;

////////////////////////////////////////////////////////////////////////////////
//                             SysInfo v. 3.00                                //
//                               jan. 2006 ã.                                 //
//                        Author - Andrey G. Sadovoy                          //
//                    (c) All rights reserved 2005-2006                       //
//                                                                            //
//        Unit consists of functions for access to system information.        //
//                        It uses Win32 API functions.                        //
//                        Unit works under Win32 only.                        //
// Additional functions #1 with usage SysInfo Component of Angel's inc.       //
// Additional functions #2 with usage of TSysInfo component by RicoSoft       //
// Additional functions #3 with usage of TSYSINFO 2.1 by Brent Boswell        //
//                                                                            //
// mailto:sadovoya@mtu-net.ru                                                 //
// http://sadovoya.narod.ru (russian)                                         //
// http://sintreseng.narod.ru (english)                                       //
////////////////////////////////////////////////////////////////////////////////

interface

uses Windows, SysUtils, TlHelp32, PSAPI, Registry;

type TProcArray = Array of String;

////////////////////////////////////////////////////////////////////////////////
//                 Functions for access to memory information.                //
//                     (Uses API-fun. GlobalMemoryStatus)                     //
////////////////////////////////////////////////////////////////////////////////

function GetMemUse:Byte;
// amount of %'s of memory usage

function GetRAM:Cardinal;
// amount of bytes of total RAM

function GetFreeRAM:Cardinal;
// amount of bytes of free RAM

function GetPage:Cardinal;
// amount of bytes, which Page file cans write (not equal to page file size)

function GetFreePage:Cardinal;
// amount of bytes, which free in PageFile

function GetVirtual:Cardinal;
// amount of bytes of virtual memory used in calling process

function GetFreeVirtual:Cardinal;
// amount of bytes of virtual memory avaible for calling process


////////////////////////////////////////////////////////////////////////////////
//                 Functions for access to OS information.                    //
//                      (uses API-fun. GetVersionEx)                          //
////////////////////////////////////////////////////////////////////////////////

function GetOS(var MajVer:Byte; var MinVer:Byte; var BuildNo:Word):String;
// Returns OS version number with build number.
// Writes OS major version number to MajVer.
// Writes minor version number to MinVer.
// Writes build number to BuildNo.

function GetOSBrief:String;
// Returns OS version number with build number.
// Short variant of previous function.

function GetPlatform: String;
// Returns platform


////////////////////////////////////////////////////////////////////////////////
//                    Functions of access to folders paths                    //
//                        (Not works in Windows 3.x)                          //
////////////////////////////////////////////////////////////////////////////////

function GetWindowsDir: string;
// Reurns path to Windows folder

function GetSystemDir: string;
// Returns path to system folder

function GetCurrentDir: string;
// Returns path to curent folder


////////////////////////////////////////////////////////////////////////////////
//      Function for access to processor information (INTEL arch. only)      //
//                       Uses API-fun. GetSystemInfo                          //
////////////////////////////////////////////////////////////////////////////////

function GetProcessorLevel:string;
// Returns processor type (or level)


////////////////////////////////////////////////////////////////////////////////
//            Functions for access to working processes.                      //
////////////////////////////////////////////////////////////////////////////////

function GetProcessesWin95(var Proc: TProcArray):Integer;
// Writes array of processes to var. Proc.
// For Win95 platform only. Uses HelpTool32Api.
// Returns amount of processes.

function GetProcessesWinNT(var Proc: TProcArray):Integer;
// Writes array of processes to var. Proc.
// For WinNT platform only. Uses PSAPI.
// Returns amount of processes.


////////////////////////////////////////////////////////////////////////////////
//    Additional functions #1 with usage of SysInfo component by Angel's inc. //
////////////////////////////////////////////////////////////////////////////////

function GetDrive(Drive: string):string;
// Returns typy of Drive (A:,B: etc.) - remote, fixed etc.

function GetCPUSpeed:Double;
// Returns CPU speed in MHz

function GetVideoCard:string;
// Returns video card

function GetKeyBoardLanguage:string;
// Returns KeyBoard language

function GetCompName:string;
// Returns name of computer

////////////////////////////////////////////////////////////////////////////////
//  Additional functions #2  with usage of TSysInfo component by RicoSoft     //
////////////////////////////////////////////////////////////////////////////////

function GetUser:string;
// Returns name of user

function GetRegInfo(var RegOwner:string; var RegOrg:string):Integer;
// Only for WinNT/95 Platform
// Returns Error Code : 0 - no errors, -1 - not NT/95 Platform
// Writes to RegOwner Registered owner
// Writes to RegOrg Registered organization

function GetOS_2: string;
// Second variant of access to OS Version

////////////////////////////////////////////////////////////////////////////////
//  Additional functions #3  with usage of TSYSINFO 2.1 by Brent Boswell      //
////////////////////////////////////////////////////////////////////////////////

function GetDriveSize(Num: Byte):string;
// Returns size in Mb of drive number Num
//Num value 0 - curent drive, 1 - A:, 2 - B:, etc.


implementation


function GetMemUse:Byte;
var MS: TMemoryStatus;
begin
MS.dwLength:=SizeOf(MS);
GlobalMemoryStatus(MS);
Result:=MS.dwMemoryLoad;
end;

function GetRAM:Cardinal;
var MS: TMemoryStatus;
begin
MS.dwLength:=SizeOf(MS);
GlobalMemoryStatus(MS);
Result:=MS.dwTotalPhys;
end;

function GetFreeRAM:Cardinal;
var MS: TMemoryStatus;
begin
MS.dwLength:=SizeOf(MS);
GlobalMemoryStatus(MS);
Result:=MS.dwAvailPhys;
end;

function GetPage:Cardinal;
var MS: TMemoryStatus;
begin
MS.dwLength:=SizeOf(MS);
GlobalMemoryStatus(MS);
Result:=MS.dwTotalPageFile;
end;

function GetFreePage:Cardinal;
var MS: TMemoryStatus;
begin
MS.dwLength:=SizeOf(MS);
GlobalMemoryStatus(MS);
Result:=MS.dwAvailPageFile;
end;

function GetVirtual:Cardinal;
var MS: TMemoryStatus;
begin
MS.dwLength:=SizeOf(MS);
GlobalMemoryStatus(MS);
Result:=MS.dwTotalVirtual;
end;

function GetFreeVirtual:Cardinal;
var MS: TMemoryStatus;
begin
MS.dwLength:=SizeOf(MS);
GlobalMemoryStatus(MS);
Result:=MS.dwAvailVirtual;
end;

function GetOS(var MajVer:Byte; var MinVer:Byte; var BuildNo:Word):String;
var VI: TOSVersionInfo;
begin
VI.dwOSVersionInfoSize:=SizeOf(VI);
GetVersionEx(VI);
MajVer:= VI.dwMajorVersion;
MinVer:= VI.dwMinorVersion;
BuildNo:= LoWord(VI.dwBuildNumber);
Result:= 'OS Version '+
        IntToStr(MajVer)+'.'+
        IntToStr(MinVer)+' build No '+
        IntToStr(BuildNo);
end;

function GetOSBrief:String;
var
VI: TOSVersionInfo;
MajVer: Byte;
MinVer: Byte;
BuildNo: Word;
begin
VI.dwOSVersionInfoSize:=SizeOf(VI);
GetVersionEx(VI);
MajVer:= VI.dwMajorVersion;
MinVer:= VI.dwMinorVersion;
BuildNo:= LoWord(VI.dwBuildNumber);
Result:= 'OS Version '+
        IntToStr(MajVer)+'.'+
        IntToStr(MinVer)+' build No '+
        IntToStr(BuildNo);
end;

function GetPlatform: String;
var VI: TOSVersionInfo;
begin
VI.dwOSVersionInfoSize:=SizeOf(VI);
GetVersionEx(VI);
Case VI.dwPlatformId of
Ver_Platform_Win32s: Result:= 'Win32s';
Ver_Platform_Win32_Windows: Result:='Win95';
Ver_Platform_Win32_NT: Result:='WinNT'
else Result:='Unknown Platform'; end;
end;

function GetWindowsDir: string;
var S: array[0..MAX_PATH] of Char;
begin
GetWindowsDirectory(S,SizeOf(S));
Result:=S;
end;

function GetSystemDir: string;
var S: array[0..MAX_PATH] of Char;
begin
GetSystemDirectory(S,SizeOf(S));
Result:=S;
end;

function GetCurrentDir: string;
var S: array[0..MAX_PATH] of Char;
begin
GetCurrentDirectory(SizeOf(S),S);
Result:=S;
end;

function GetProcessorLevel:string;
var SI: TSystemInfo;
begin
GetSystemInfo(SI);
Case SI.wProcessorLevel of
3: Result:='80386';
4: Result:='80486';
5: Result:='Pentium';
6: Result:='Pentium Pro'
else Result:=IntToStr(SI.wProcessorLevel);end;
end;

function GetProcessesWin95(var Proc: TProcArray):Integer;
var
FSnap: THandle;
PE: TProcessEntry32;
PPE: PProcessEntry32;
I: Integer;
begin
If FSnap > 0 then CloseHandle(FSnap);
FSnap:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
PE.dwSize:=SizeOf(PE);
I:=0;
SetLength(Proc,1000);
If Process32First(FSnap,PE) then
  repeat
    New(PPE);
    PPE^:=PE;
    Proc[I]:=PPE.szExeFile;
    I:=I+1;
  until not Process32Next(FSnap,PE);
Result:=I;
end;

function GetProcessesWinNT(var Proc: TProcArray):Integer;
var
Num: Integer;
LP: Array[0..$3FFF-1] of Dword;
CB: DWord;
CBNeeded:DWord;
ProcHndl: THandle;
ModHand: HModule;
ModName: array [0..MAX_PATH] of Char;
I: Integer;
begin
  EnumProcesses(@LP,CB,CBNeeded);
  Num:= CBNeeded div SizeOf(DWORD);
  SetLength(Proc,Num);
 For I:=0 to Num-1 do
  begin
    ProcHndl:=
    OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,LP[I]);
    If GetModuleFileNameEx(ProcHndl,ModHand,ModName,SizeOf(ModName))> 0 then
    Proc[I]:=ModName else Proc[I]:='Unknown';
  end;
IF ProcHndl > 0 then CloseHandle(ProcHndl);
Result:=Num;
end;

function GetDrive(Drive: string):string;
var
DriveType : uInt;
begin
DriveType := GetDriveType(PChar(Drive));
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 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 GetVideoCard:String;
var
  lpDisplayDevice: TDisplayDevice;
  dwFlags: DWORD;
  cc: DWORD;  
begin  
lpDisplayDevice.cb := sizeof(lpDisplayDevice);
dwFlags := 0;  
cc:= 0;  
while EnumDisplayDevices(nil, cc, lpDisplayDevice , dwFlags) do  
  begin  
    Inc(cc);
    Result:=lpDisplayDevice.DeviceName;
  end;
end;

function GetKeyBoardLanguage:string;
var
ID:LangID;
Language: array [0..100] of char;
begin
ID:=GetSystemDefaultLangID;
VerLanguageName(ID,Language,100);
Result:=String(Language);
end;

function GetCompName:string;
var
i:DWORD;
p:PChar;
begin
i:=255;
GetMem(p, i);
GetComputerName(p, i);
Result:=String(p);
FreeMem(p);
end;

function GetUser:string;
var
   UserName : PChar;
   NameSize : DWORD;
begin
   UserName := #0;
   NameSize := 50;
   try
      GetMem(UserName, NameSize);
      GetUserName(UserName, NameSize);
      Result:= StrPas(UserName);
   finally
      FreeMem(UserName);
   end;
end;

function GetRegInfo(var RegOwner:string; var RegOrg:string):Integer;
const
  WIN95_KEY = '\SOFTWARE\Microsoft\Windows\CurrentVersion';
  WINNT_KEY = '\SOFTWARE\Microsoft\Windows NT\CurrentVersion';
var
  VersionKey : PChar;
begin
    Result:=0;
    If GetPlatform = 'Win95' then VersionKey := WIN95_KEY else
    If GetPlatform = 'WinNT' then VersionKey := WINNT_KEY else
    begin Result:=-1; exit; end;
   with TRegistry.Create do
   try
       RootKey := HKEY_LOCAL_MACHINE;
       if OpenKey(VersionKey, False) then
          begin
          RegOwner:= ReadString('RegisteredOwner');
          RegOrg:= ReadString('RegisteredOrganization');
          end;
   finally
     Free;
   end;
end;

function GetOS_2: string;
var
  OSVersion: TOSVersionInfo;
begin
   OSVersion.dwOSVersionInfoSize := SizeOf(OSVersion);
   if GetVersionEx(OSVersion) then
   Result:= Format('%d.%d (%d.%s)',
   [OSVersion.dwMajorVersion, OSVersion.dwMinorVersion,
   (OSVersion.dwBuildNumber and $FFFF), OSVersion.szCSDVersion]);
end;

function GetDriveSize(Num: Byte):string;
begin
if DiskSize(Num) <> -1 then
      Result := format('%d MB', [Trunc(DiskSize(Num)/1024/1024)])
   else
      Result := '';
end;

end.
