Hardware Information Library

{*******************************************************}

{                                                       }

{       Hardware Information Library                    }

{       2006, Gullb3rg                                  }

{       Codius                                          }

{                                                       }

{*******************************************************}

Unit unHardwareInformation;

Interface

Uses

  Windows, Classes;

Type

  TRProcessorInformation = Record

    Speed           : Integer;

    Level           : Integer;

    Count           : Integer;

    Name            : String;

    Architecture    : String;

    Identifier      : String;

    Revision        : String;

  End;

  TRMemoryInformation = Record

    MemoryUsage     : Integer;

    MemoryTotal     : Integer;

    MemoryAvailable : Integer;

  End;

  TCProcessorInformation = Class

  Private

    RProcessorInformation             : TRProcessorInformation;

    Function    GetProcSpeed          : Integer;

    Function    GetProcLevel          : Integer;

    Function    GetProcCount          : Integer;

    Function    GetProcName           : String;

    Function    GetProcArchitecture   : String;

    Function    GetProcIdentifier     : String;

    Function    GetProcRevision       : String;

    Function    ViewProcSpeed         : Integer;

    Function    ViewProcLevel         : Integer;

    Function    ViewProcCount         : Integer;

    Function    ViewProcName          : String;

    Function    ViewProcArchitecture  : String;

    Function    ViewProcIdentifier    : String;

    Function    ViewProcRevision      : String;

  Public

    Constructor Create;

    Procedure   Refresh;

    Property    ProcSpeed             : Integer Read ViewProcSpeed;

    Property    ProcLevel             : Integer Read ViewProcLevel;

    Property    ProcCount             : Integer Read ViewProcCount;

    Property    ProcName              : String  Read ViewProcName;

    Property    ProcArchitecture      : String  Read ViewProcArchitecture;

    Property    ProcIdentifier        : String  Read ViewProcIdentifier;

    Property    ProcRevision          : String  Read ViewProcRevision;

  End;

  TCMemoryInformation = Class

  Private

    RMemoryInformation                : TRMemoryInformation;

    Function    GetMemoryUsage        : Integer;

    Function    GetMemoryTotal        : Integer;

    Function    GetMemoryAvailable    : Integer;

    Function    ViewMemoryUsage       : Integer;

    Function    ViewMemoryTotal       : Integer;

    Function    ViewMemoryAvailable   : Integer;

  Public

    Constructor Create;

    Procedure   Refresh;

    Property    MemoryUsage           : Integer Read ViewMemoryUsage;

    Property    MemoryTotal           : Integer Read ViewMemoryTotal;

    Property    MemoryAvailable       : Integer Read ViewMemoryAvailable;

  End;

  TCHardDiskInformation = Class

  Public

    Function    GetTotSpace(drv: PChar)    : Integer;

    Function    GetFreeSpace(drv: PChar)   : Integer;

    Function    GetDrvType(drv : PChar)    : String;

    Function    GetFileSysType(drv: PChar) : String;

    Function    GetVolumeName(drv: PChar)  : String;

    Function    GetDrives(var sList: TStringList): Integer;

  End;

  TDrvType = (dtNotDetermined, dtNonExistent, dtRemoveable,

              dtFixed, dtRemote, dtCDROM, dtRamDrive);

implementation

{ IntToStr

  This function is used to convert integers to strings. }

Function IntToStr(Const Value: Integer): String;

Var

  s                 : String[11];

Begin

  Str(Value, s);

  Result := s;

End;

{ StrToInt

  This function is used to convert strings to integers. }

Function StrToInt(Const s: String): Integer;

Var

  e                 : integer;

Begin

  val(s, Result, e);

End;

{ TCProcessorInformation.Create

  This constructor will initialize the processor record. }

Constructor TCProcessorInformation.Create;

Begin

  Inherited;

  Refresh;

End;

{ TCProcessorInformation.Refresh

  This routine will refresh the processor record. }

Procedure TCProcessorInformation.Refresh;

Begin

  RProcessorInformation.Speed         := GetProcSpeed;

  RProcessorInformation.Level         := GetProcLevel;

  RProcessorInformation.Count         := GetProcCount;

  RProcessorInformation.Name          := GetProcName;

  RProcessorInformation.Architecture  := GetProcArchitecture;

  RProcessorInformation.Identifier    := GetProcIdentifier;

  RProcessorInformation.Revision      := GetProcRevision;

End;

{ TCProcessorInformation.ViewProcSpeed

  This routine will return the processor speed. }

Function TCProcessorInformation.ViewProcSpeed: Integer;

Begin

  Result := RProcessorInformation.Speed;

End;

{ TCProcessorInformation.ViewProcCount

  This routine will return the amount of processors. }

Function TCProcessorInformation.ViewProcCount: Integer;

Begin

  Result := RProcessorInformation.Count;

End;

{ TCProcessorInformation.ViewProcLevel

  This routine will return the processor level. }

Function TCProcessorInformation.ViewProcLevel: Integer;

Begin

  Result := RProcessorInformation.Level;

End;

{ TCProcessorInformation.ViewProcName

  This routine will return the processor name. }

Function TCProcessorInformation.ViewProcName: String;

Begin

  Result := RProcessorInformation.Name;

End;

{ TCProcessorInformation.ViewProcArchitecture

  This routine will return the processor architecture. }

Function TCProcessorInformation.ViewProcArchitecture: String;

Begin

  Result := RProcessorInformation.Architecture;

End;

{ TCProcessorInformation.ViewProcIdentifier

  This routine will return the processor identifier. }

Function TCProcessorInformation.ViewProcIdentifier: String;

Begin

  Result := RProcessorInformation.Identifier;

End;

{ TCProcessorInformation.ViewProcRevision

  This routine will return the processor revision. }

Function TCProcessorInformation.ViewProcRevision: String;

Begin

  Result := RProcessorInformation.Revision;

End;

{ TCProcessorInformation.GetProcName

  This routine is used to retrieve the processor name. }

Function TCProcessorInformation.GetProcName: String;

Const

  Size              : Integer = 2048;

Var

  Temp              : HKEY;

  Res               : pChar;

Begin

  GetMem(Res, (MAX_PATH + 1));

  RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0', 0, KEY_QUERY_VALUE, Temp);

  RegQueryValueEx(HKEY_LOCAL_MACHINE, 'ProcessorNameString', NIL, NIL, pByte(Res), @Size);

  RegCloseKey(Temp);

  Result := pChar(Res);

  FreeMem(Res);

End;

{ TCProcessorInformation.GetProcSpeed

  This routine is used to retrieve the processor speed. }

Function TCProcessorInformation.GetProcSpeed: Integer;

Const

  Size              : Integer = 2048;

Var

  Temp              : HKEY;

Begin

  RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0', 0, KEY_QUERY_VALUE, Temp);

  RegQueryValueEx(Temp, '~MHz', NIL, NIL, @Result, @Size);

  RegCloseKey(Temp);

End;

{ TCProcessorInformation.GetProcArchitecture

  This routine is used to retrieve the processor architecture. }

Function TCProcessorInformation.GetProcArchitecture: String;

Var

  EnvVarLength      : Integer;

  EnvVarString      : String;

Begin

  Result := '';

  EnvVarLength := GetEnvironmentVariable('PROCESSOR_ARCHITECTURE', NIL, 0);

  If (EnvVarLength > 0) Then

  Begin

    SetLength(EnvVarString, EnvVarLength);

    GetEnvironmentVariable('PROCESSOR_ARCHITECTURE', pChar(EnvVarString), EnvVarLength);

    SetLength(EnvVarString, (EnvVarLength - 1));

    Result := EnvVarString;

  End;

End;

{ TCProcessorInformation.GetProcLevel

  This routine is used to retrieve the processor level. }

Function TCProcessorInformation.GetProcLevel: Integer;

Var

  EnvVarLength      : Integer;

  EnvVarString      : String;

Begin

  Result := -1;

  EnvVarLength := GetEnvironmentVariable('PROCESSOR_LEVEL', NIL, 0);

  If (EnvVarLength > 0) Then

  Begin

    SetLength(EnvVarSTring, EnvVarLength);

    GetEnvironmentVariable('PROCESSOR_LEVEL', pChar(EnvVarString), EnvVarLength);

    SetLength(EnvVarString, (EnvVarLength - 1));

    Result := StrToInt(EnvVarString);

  End;

End;

{ TCProcessorInformation.GetProcIdentifier

  This routine is used to retrieve the processor identifier. }

Function TCProcessorInformation.GetProcIdentifier: String;

Var

  EnvVarLength      : Integer;

  EnvVarString      : String;

Begin

  Result := '';

  EnvVarLength := GetEnvironmentVariable('PROCESSOR_IDENTIFIER', NIL, 0);

  If (EnvVarLength > 0) Then

  Begin

    SetLength(EnvVarSTring, EnvVarLength);

    GetEnvironmentVariable('PROCESSOR_IDENTIFIER', pChar(EnvVarString), EnvVarLength);

    SetLength(EnvVarString, (EnvVarLength - 1));

    Result := EnvVarString;

  End;

End;

{ TCProcessorInformation.GetProcRevision

  This routine is used to retrieve the processor revision. }

Function TCProcessorInformation.GetProcRevision: String;

Var

  EnvVarLength      : Integer;

  EnvVarString      : String;

Begin

  Result := '';

  EnvVarLength := GetEnvironmentVariable('PROCESSOR_REVISION', NIL, 0);

  If (EnvVarLength > 0) Then

  Begin

    SetLength(EnvVarSTring, EnvVarLength);

    GetEnvironmentVariable('PROCESSOR_REVISION', pChar(EnvVarString), EnvVarLength);

    SetLength(EnvVarString, (EnvVarLength - 1));

    Result := EnvVarString;

  End;

End;

{ TCProcessorInformation.GetProcCount

  This routine is used to retrieve the amount of processors. }

Function TCProcessorInformation.GetProcCount: Integer;

Var

  EnvVarLength      : Integer;

  EnvVarString      : String;

Begin

  Result := -1;

  EnvVarLength := GetEnvironmentVariable('NUMBER_OF_PROCESSORS', NIL, 0);

  If (EnvVarLength > 0) Then

  Begin

    SetLength(EnvVarSTring, EnvVarLength);

    GetEnvironmentVariable('NUMBER_OF_PROCESSORS', pChar(EnvVarString), EnvVarLength);

    SetLength(EnvVarString, (EnvVarLength - 1));

    Result := StrToInt(EnvVarString);

  End;

End;

{ TMemoryInformation.Create

  This constructor will initialize the memory record. }

Constructor TCMemoryInformation.Create;

Begin

  Inherited;

  Refresh;

End;

{ TMemoryInformation.Refresh

  This routine will refresh the memory record. }

Procedure TCMemoryInformation.Refresh;

Begin

  RMemoryInformation.MemoryUsage      := GetMemoryUsage;

  RMemoryInformation.MemoryTotal      := GetMemoryTotal;

  RMemoryInformation.MemoryAvailable  := GetMemoryAvailable;

End;

{ TMemoryInformation.ViewMemoryUsage

  This routine will return the amount of memory used. }

Function TCMemoryInformation.ViewMemoryUsage: Integer;

Begin

  Result := RMemoryInformation.MemoryUsage;

End;

{ TMemoryInformation.ViewMemoryTotal

  This routine will return the total amount of physical memory. }

Function TCMemoryInformation.ViewMemoryTotal: Integer;

Begin

  Result := RMemoryInformation.MemoryTotal;

End;

{ TMemoryInformation.ViewMemoryAvailable

  This routine will return the amount of memory available. }

Function TCMemoryInformation.ViewMemoryAvailable: Integer;

Begin

  Result := RMemoryInformation.MemoryAvailable;

End;

{ TMemoryInformation.GetMemoryUsage

  This routine is used to retrieve the amount of memory used. }

Function TCMemoryInformation.GetMemoryUsage: Integer;

Var

  MemoryStatus      : TMemoryStatus;

Begin

  MemoryStatus.dwLength := SizeOf(MemoryStatus);

  GlobalMemoryStatus(MemoryStatus);

  Result := Memorystatus.dwMemoryLoad;

End;

{ TMemoryInformation.GetMemoryTotal

  This routine is used to retrieve the total amount of physical memory. }

Function TCMemoryInformation.GetMemoryTotal: Integer;

Var

  MemoryStatus      : TMemoryStatus;

Begin

  MemoryStatus.dwLength := SizeOf(MemoryStatus);

  GlobalMemoryStatus(MemoryStatus);

  Result := (MemoryStatus.dwTotalPhys DIV 1048576);

End;

{ TMemoryInformation.GetMemoryAvailable

  This routine is used to retrieve the amount of memory available. }

Function TCMemoryInformation.GetMemoryAvailable: Integer;

Var

  MemoryStatus      : TMemoryStatus;

Begin

  MemoryStatus.dwLength := SizeOf(MemoryStatus);

  GlobalMemoryStatus(MemoryStatus);

  Result := (MemoryStatus.dwAvailPhys DIV 1048576);

End;

{ TCHardDiskInformation.GetDrives

  This routine will give you the name of your drives. }

Function TCHardDiskInformation.GetDrives(var sList: TStringList): Integer;

const

  DRIVE_UNKNOWN             = 0;

  DRIVE_NO_ROOT_DIR         = 1;

  DRIVE_REMOVABLE           = 2;

  DRIVE_FIXED               = 3;

  DRIVE_REMOTE              = 4;

  DRIVE_CDROM               = 5;

  DRIVE_RAMDISK             = 6;

var

  R                         : LongWord;

  Drives                    : Array[0..128] of Char;

  pDrive                    : PChar;

begin

  Result := 0;

  sList.Clear;

  R := GetLogicalDriveStrings(SizeOf(Drives), Drives);

  If r = 0 then

    Exit;

  If R > SizeOf(Drives) then

    Exit;

  pDrive := Drives;

  while pDrive^ <> #0 do

  begin

    if GetDriveType(pDrive) <> DRIVE_UNKNOWN then

      sList.Append(String(pDrive));

    Inc(pDrive, 4);

    Inc(Result, 1);

  end;

end;

{ Here is an example of how to use it. }

{Var

  temp        : Integer;

  sTemp       : TStringList;

  I           : Integer;

begin

  sTemp := TStringList.Create;

  temp := GetDrives(sTemp);

  For i := 0 To (sTemp.Count - 1) Do

  begin

    WriteLn(sTemp.Strings[i]);

    WriteLn('  Volume Name      : ' + GetVolumeName(pChar(sTemp.Strings[i])));

    WriteLn('  Total disk space : ' + IntToStr(GetTotDiskSpace(pChar(sTemp.Strings[i]))) + ' Mb');

    WriteLn('  Free disk space  : ' + IntToStr(GetFreeSpace(pChar(sTemp.Strings[i]))) + ' Mb');

    WriteLn('  File type        : ' + GetFileSysType(pChar(sTemp.Strings[i])));

    WriteLn('  Drive type       : ' + GetDrvType(sTemp.Strings[i]));

    WriteLn;

  end;

}

{ StrPas

  To use StrPas. }

function StrPas(const Str: PChar): string;

begin

  Result := Str;

end;

{ TCHardDisk.GetTotSpace

  This routine will return total space on the drive. }

Function TCHardDiskInformation.GetTotSpace(drv : PChar): Integer;

Var

  TotalSize        : Int64;

  FreeSize         : Int64;

Begin

  GetDiskFreeSpaceEx(drv, TotalSize, FreeSize, NIL);

  FreeSize := FreeSize DIV 1024 DIV 1024;

  Result := FreeSize;

end;

{ TCHardDiskInformation.GetFreeSpace

  This routine will return total free space on the drive. }

Function TCHardDiskInformation.GetFreeSpace(drv: PChar): Integer;

Var

  TotalSize       : Int64;

  FreeSize        : Int64;

Begin

  GetDiskFreeSpaceEx(drv, TotalSize, FreeSize, NIL);

  TotalSize := TotalSize DIV 1024 DIV 1024;

  Result := TotalSize;

End;

{ TCHardDiskInformation.GetDrvType

  This routine will return the drive type. }

Function TCHardDiskInformation.GetDrvType(drv : PChar): String;

Var

  dType           : TDrvType;

Begin

  dType := TDrvType(GetDriveType(PChar(drv)));

  case dType of

    dtNotDetermined : Result := 'Unable to Determine';

    dtNonExistent   : Result := 'Does not exist';

    dtRemoveable    : Result := 'Removable Drive (Floppy)';

    dtFixed         : Result := 'Fixed Disk';

    dtRemote        : Result := 'Remote or Network Drive';

    dtCDROM         : Result := 'CD-ROM Drive';

    dtRamDrive      : Result := 'RAM Drive';

  end;

End;

{ TCHardDiskInformation.GetFileSysType

  This routine will return the file system type. }

Function TCHardDiskInformation.GetFileSysType(drv: PChar): String;

Var

  pFSBuf       : PChar;

  pVolName     : PChar;

  nVNameSer    : PDWORD;

  FSSysFlags   : DWORD;

  maxCmpLen    : DWORD;

Begin

  GetMem(pVolName, MAX_PATH);

  GetMem(pFSBuf, MAX_PATH);

  GetMem(nVNameSer, MAX_PATH);

  GetVolumeInformation(PChar(drv), pVolName, MAX_PATH, nVNameSer, maxCmpLen, FSSysFlags, pFSBuf, MAX_PATH);

  Result := StrPas(pFSBuf);

  FreeMem(pVolName, MAX_PATH);

  FreeMem(pFSBuf, MAX_PATH);

  FreeMem(nVNameSer, MAX_PATH);

End;

{ TCHardDiskInformation.GetVolumeName

  This routine will return the volume name of the drive. }

Function TCHardDiskInformation.GetVolumeName(drv: PChar): String;

Var

  pFSBuf       : PChar;

  pVolName     : PChar;

  nVNameSer    : PDWORD;

  FSSysFlags   : DWORD;

  maxCmpLen    : DWORD;

Begin

  GetMem(pVolName, MAX_PATH);

  GetMem(pFSBuf, MAX_PATH);

  GetMem(nVNameSer, MAX_PATH);

  GetVolumeInformation(PChar(drv), pVolName, MAX_PATH, nVNameSer, maxCmpLen, FSSysFlags, pFSBuf, MAX_PATH);

  Result := StrPas(pVolName);

  FreeMem(pVolName, MAX_PATH);

  FreeMem(pFSBuf, MAX_PATH);

  FreeMem(nVNameSer, MAX_PATH);

End;

End.