unit SystemInfo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Math, Controls, Forms, Dialogs, Registry;

type
 //Record to hold disk drive info
 PDrive_Rec = ^TDrive_Rec;
  TDrive_Rec = record
    strDrive : String;
    lngFreeSpace : longint;
    lngTotalSpace : longint;
    strType : String; //CD, removeable, etc
    strVolName : string;
    lngSerialNo : longint;
    lngFSFlags : longint;
    strFSName : String;

  end;

  //List to hold info about all connected drives
  TDriveList = class(TList)
    Destructor Destroy; override;
    procedure AddDrive(DiskDrive: TDrive_Rec);
    procedure Delete(Index : Integer);
    function DriveName(Index : Integer) : String;
    function FreeSpace(Index : Integer) : Longint;
    function TotalSpace(Index : Integer) : Longint;
    function DriveType(Index : Integer) : String;
    function VolName(Index : Integer) : String;
    function SerialNo(Index : integer) : longint;
    function FSFlags(Index : integer) : longint;
    function FSName(Index : Integer) : string;
  end;

type
  TSysInfo = class(TComponent)
  private
    { Private declarations }
    fProcessorType : String;
    fProcessorArchitecture : String;
    fOSName : String;
    fNoProcessors : integer;
    fCPUSpeed : Comp;
    fBuildNo : longint;
    fOSMajor : longint;
    fOSMinor : longint;
    fServicePack : string;
    fMemAvailablePhys : longint;
    fMemTotalPhys : longint;
    fMemLoad : longint; //Percent of memory in use
    fTotalPageFile : longint;
    fAvailPageFile : longint;
    fTotalVirtual : longint;
    fAvailVirtual : longint;
    fACLineStatus : string;
    fBatteryFlag : string;
    fBatteryLifePercent : integer;
    fBatteryLifeTime : longint;
    fBatteryFullTime : longint;
    fUserName : string;
    fComputerName : string;
    fWinDir : string;
    fWinSysDir : string;

    fDaylightSaving : boolean;
    FDaylightTimeZone : string;
    FDaylightDate : TDateTime;
    FStandardDate : TDateTime;
    FTimeZone : string;
    FBias : longint;
    FDaylightBias : longint;
    FDaylightDay : string;
    FDaylightDayNo : string;
    FDaylightMonth : string;
    FDaylightSavingHour : TDateTime;
    FStandardDay : string;
    FStandardDayNo : string;
    FStandardMonth : string;
    FStandardHour : TDateTime;


    fVideoRes : string;
    fNoColors : extended;

    fDiskFree : Int64;
    fFreeClusters : Int64;
    fSectorsPerCluster : Int64;
    fBytesPerSector : Int64;
    fTotalClusters : Int64;

    fHostName : string;

    fRegisteredUser : string;
    fRegisteredCompany : string;
    fCDNo : string;

    fDriveList : TDriveList;
    function GetDaylightSavingNo(wDay : Word) : string;
    function GetDaylightSavingDay(wDayOfWeek : Word) : string;
    function GetDaylightSavingMonth(wMonth : Word) : string;

  protected
    { Protected declarations }
    procedure InitInfo;
    procedure GetTimeZoneInfo;
    procedure GetDiskSpaceFree(Drive : Char);
    procedure GetFreeSpaceOnDrive(intDrive : integer; var lngFreeSpace : Int64;
      var lngTotalBytes : Int64);
    function GetVolInfo(ADriveRec : TDrive_Rec) : TDrive_Rec;
    procedure GetVideoInfo;
    procedure GetRegisteredInfo;
    procedure GetComputerName;
    procedure GetUserName;
    function GetCPUSpeed : Comp;
    procedure LoadDiskFreeEx;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    function GetDiskDrives : TDriveList;
    procedure GetSystemStatus;
    procedure DisplaySystemStatus(Strings : TStrings);
  published
    { Published declarations }
    property ProcessorType : string read fProcessorType;
    property ProcessorArchitecture : string read fProcessorArchitecture;
    property CPUSpeed : Comp read fCPUSpeed;
    property OperatingSystem : string read fOSName;
    property NumberOfProcessors : longint read fNoProcessors;
    property BuildNo : longint read fBuildNo;
    property OSVerMajor : longint read fOSMajor;
    property OSVerMinor : longint read fOSMinor;
    property ServicePack : string read fServicePack;
    property MemAvailPhysical : longint read fMemAvailablePhys;
    property MemAvailTotal : longint read fMemTotalPhys;
    property PageFileTotal : longint read fTotalPageFile;
    property PageFileAvail : longint read fAvailPageFile;
    property MemVirtualTotal : longint read fTotalVirtual;
    property MemVirtualAvail : longint read fAvailVirtual;
    property ACLineStatus : string read fACLineStatus;
    property BatteryStatus : string read fBatteryFlag;
    property BatteryLifePercent : longint read fBatteryLifePercent;
    property BatteryLife : longint read fBatteryLifeTime;
    property BatteryFullTime : longint read fBatteryFullTime;
    property WindowsDir : string read fWinDir;
    property WinSysDir : string read fWinSysDir;

    property DaylightSaving : boolean read fDaylightSaving;
    property DaylightTimeZone : string read FDaylightTimeZone;
    property DaylightDate : TDateTime read FDaylightDate;
    property StandardDate : TDateTime read FStandardDate;
    property TimeZone : string read FTimeZone;
    property Bias : longint read FBias;
    property DaylightBias : longint read FDaylightBias;
    property DaylightDayNo : string read FDaylightDayNo;
    property DaylightDay : string read FDaylightDay;
    property DaylightMonth : string read FDaylightMonth;
    property DaylightHour : TDateTime read FDaylightSavingHour;
    property StandardDayNo : string read FStandardDayNo;
    property StandardDay : string read FStandardDay;
    property StandardMonth : string read FStandardMonth;
    property StandardHour : TDateTime read FStandardHour;

    property VideoResolution : string read fVideoRes;
    property NumberOfColours : extended read fNoColors;

    property DiskFree : Int64 read fDiskFree;
    property FreeClusters : Int64 read fFreeClusters;
    property SectorsPerCluster : Int64 read fSectorsPerCluster;
    property BytesPerSector : Int64 read fBytesPerSector;
    property TotalClusters : Int64 read fTotalClusters;

    property ComputerName : string read fComputerName;
    property UserName : string read fUserName;
    property HostName : string read fHostName;

    property RegisteredUser : string read fRegisteredUser;
    property RegisteredCompany : string read fRegisteredCompany;
    property CDNumber : string read fCDNo;

  end;

{$R sysinfo.res}

procedure Register;

implementation

const PROCESSOR_INTEL_386     = 386;
const PROCESSOR_INTEL_486     = 486;
const PROCESSOR_INTEL_PENTIUM = 586;
const PROCESSOR_INTEL_860     = 860;
const PROCESSOR_MIPS_R2000    = 2000;
const PROCESSOR_MIPS_R3000    = 3000;
const PROCESSOR_MIPS_R4000    = 4000;
const PROCESSOR_ALPHA_21064   = 21064;
const PROCESSOR_PPC_601       = 601;
const PROCESSOR_PPC_603       = 603;
const PROCESSOR_PPC_604       = 604;
const PROCESSOR_PPC_620       = 620;

Const PROCESSOR_ARCHITECTURE_INTEL = 0;
Const PROCESSOR_ARCHITECTURE_MIPS = 1;
Const PROCESSOR_ARCHITECTURE_ALPHA = 2;
Const PROCESSOR_ARCHITECTURE_PPC =  3;
Const PROCESSOR_ARCHITECTURE_UNKNOWN = $FFFF;

Const   TIME_ZONE_ID_UNKNOWN  = 0;
Const   TIME_ZONE_ID_STANDARD = 1;
Const   TIME_ZONE_ID_DAYLIGHT = 2;

Const DRIVE_REMOVABLE = 2;
Const DRIVE_FIXED = 3;
Const DRIVE_REMOTE = 4;
Const DRIVE_CDROM = 5;
Const DRIVE_RAMDISK = 6;

Const
  HKEY_CLASSES_ROOT = $80000000;
  HKEY_CURRENT_USER = $80000001;
  HKEY_LOCAL_MACHINE = $80000002;
  HKEY_USERS = $80000003;
  HKEY_PERFORMANCE_DATA = $80000004;

Const DiskSpaceEx_Loaded : Boolean = False; //See if GetDiskSpaceFreeEx is loaded
var
  GetDiskFreeSpaceEx : FUNCTION (lpDirectoryName          : PChar;
                                 lpFreeBytesAvailableToCaller,
                                 lpTotalNumberOfBytes,
                                 lpTotalNumberOfFreeBytes :
                                 PLargeInteger) : Bool; STDCALL;
  Lib : THandle;

procedure Register;
begin
  RegisterComponents('Win32', [TSysInfo]);
end;
{--------------------------- TDriveList -------------------------}
Destructor TDriveList.Destroy;
var
 I : Integer;
begin
  //Free all the items in the list
  For I := 0 to (Count - 1) do
     Dispose(PDrive_Rec(Items[I]));
  Clear;
  inherited Destroy;
end;

procedure TDriveList.AddDrive(DiskDrive: TDrive_Rec);
var
  MyDrive: PDrive_Rec;
begin
  MyDrive := New(PDrive_Rec);
  MyDrive^ := DiskDrive;
  Add(MyDrive);
end;

procedure TDriveList.Delete(Index : Integer);
{Free memory used by list items.}
begin
  ShowMessage(IntToStr(Count));
  if (PDrive_Rec(Items[Index])) <> nil then
  begin
    Dispose(PDrive_Rec(Items[Index]));
    Items[Index] := Nil;
  end;  
  Inherited Delete(Index);

end;

function TDriveList.DriveName(Index : Integer) : String;
begin
  Result := PDrive_Rec(Items[Index])^.strDrive;
end;

function TDriveList.FreeSpace(Index : Integer) : Integer;
begin
  Result := PDrive_Rec(Items[Index])^.lngFreeSpace;
end;

function TDriveList.TotalSpace(Index : Integer) : Integer;
begin
  Result := PDrive_Rec(Items[Index])^.lngTotalSpace;
end;

function TDriveList.DriveType(Index : Integer) : String;
begin
  Result := PDrive_Rec(Items[Index])^.strType;
end;

function TDriveList.VolName(Index : Integer) : String;
begin
  Result := PDrive_Rec(Items[Index])^.strVolName;
end;

function TDriveList.SerialNo(Index : integer) : longint;
begin
  Result := PDrive_Rec(Items[Index])^.lngSerialNo
end;

function TDriveList.FSFlags(Index : integer) : longint;
begin
  Result := PDrive_Rec(Items[Index])^.lngFSFlags;
end;

function TDriveList.FSName(Index : Integer) : string;
begin
  Result := PDrive_Rec(Items[Index])^.strFSName;
end;

{--------------------- TSysInfo ---------------------}
constructor TSysInfo.Create(AOwner : TComponent);
begin
   inherited Create(AOwner);
   fProcessorType := '';
   fProcessorArchitecture := '';
   fOSName := '';
   fNoProcessors := 0;
   fCPUSpeed := 0;
   fBuildNo := 0;
   fOSMajor := 0;
   fOSMinor := 0;
   fServicePack := '';
   fMemAvailablePhys := 0;
   fMemTotalPhys := 0;
   fMemLoad := 0; //Percent of memory in use
   fTotalPageFile := 0;
   fAvailPageFile := 0;
   fTotalVirtual := 0;
   fAvailVirtual := 0;
   fACLineStatus := '';
   fBatteryFlag := '';
   fBatteryLifePercent := 0;
   fBatteryLifeTime := 0;
   fBatteryFullTime := 0;
   fUserName := '';
   fComputerName := '';
   fWinDir := '';
   fWinSysDir := '';

   fDaylightSaving := false;
   FDaylightTimeZone := '';
   FDaylightDate := 0;
   FStandardDate := 0;
   FTimeZone := '';
   FBias := 0;
   FDaylightTimeZone := '';
   FBias := 0;
   FDaylightDay := '';
   FDaylightDayNo := '';
   FDaylightMonth := '';
   FDaylightSavingHour := 0;
   FStandardDay := '';
   FStandardDayNo := '';
   FStandardMonth := '';
   FStandardHour := 0;

   fVideoRes := '';
   fNoColors := 0;

   fDiskFree := 0;
   fFreeClusters := 0;
   fSectorsPerCluster := 0;
   fBytesPerSector := 0;
   fTotalClusters := 0;

   fHostName := '';

   fRegisteredUser := '';
   fRegisteredCompany := '';
   fCDNo := '';

   fDriveList := TDriveList.Create;

   {Most of the stuff here, such as processor type is unlikely
    to change during the time that the program is running, so
    it is determined during the Create event}
   InitInfo; //Processor type, memory, paging file, etc
   GetTimeZoneInfo;
   GetVideoInfo;
   GetDiskSpaceFree(ExtractFileDrive(Application.ExeName)[1]);  //Info about current drive (usually C) only
   GetUserName;
   GetRegisteredInfo;
   GetComputerName;
end;

destructor TSysInfo.Destroy;
begin
  fDriveList.Free;
  inherited Destroy;
end;

function TSysInfo.GetDaylightSavingNo(wDay : Word) : string;
//Returns First, second, etc for daylight or standard day.
begin
  Case wDay of
    1 : Result := 'First';
    2 : Result := 'Second';
    3 : Result := 'Third';
    4 : Result := 'Fourth';
    5 : Result := 'Last';
  else
    Result := '';
  end;
end;

function TSysInfo.GetDaylightSavingDay(wDayOfWeek : Word) : string;
//Returns day of week dyalight saving or standard time starts.
begin
  Case wDayOfWeek of
     0 : Result := 'Sunday';
     1 : Result := 'Monday';
     2 : Result := 'Tuesday';
     3 : Result := 'Wednesday';
     4 : Result := 'Thursday';
     5 : Result := 'Friday';
     6 : Result := 'Saturday';
     7 : Result := 'Sunday';
   end;
end;

function TSysInfo.GetDaylightSavingMonth(wMonth : Word) : string;
//Returns month that daylight saving or standard time starts.
begin
  Case wMonth of
    1  : Result := 'January';
    2  : Result := 'February';
    3  : Result := 'March';
    4  : Result := 'April';
    5  : Result := 'May';
    6  : Result := 'June';
    7  : Result := 'July';
    8  : Result := 'August';
    9  : Result := 'September';
    10 : Result := 'October';
    11 : Result := 'November';
    12 : Result := 'December';
  else
    Result := '';
  end;
end;

procedure TSysInfo.GetSystemStatus;
//Refresh various bits of info. Used
//by the COM interface.
begin
   InitInfo; //Processor type, memory, paging file, etc
   GetTimeZoneInfo;
   GetVideoInfo;
   GetDiskSpaceFree('C');  //Info about drive C only
   GetUserName;
   GetRegisteredInfo;
   GetComputerName;
end;

procedure TSysInfo.DisplaySystemStatus(Strings : TStrings);
{Return status info as a string list for use in the
 COM Interface}
begin
  with Strings Do
  begin
    Clear;
    Add('Computer Name: ' + ComputerName);
    Add('Processor type:' + ProcessorType);
    Add('Processor arhitecture.' + ProcessorArchitecture);
    Add('Operating system: ' + OperatingSystem);
    Add('Number of processors: ' + IntToStr(NumberOfProcessors));
    Add('*** Operating System info ***');
    Add('Operating system Version: ' + IntToStr(OSVerMajor) +
    '.' + IntToStr(OSVerMinor));
    Add('Build number: ' + IntToStr(BuildNo));
    Add('Service Pack: ' + ServicePack);
    Add('Windows directory: ' + WindowsDir);
    Add('Windows system directory: ' + WinSysDir);
    Add('*** Battery Status info ***');
    Add('Battery Status: ' + BatteryStatus);
    Add('Battery Life Percent: ' + IntToStr(BatteryLifePercent));
    Add('Battery Life: ' + IntToStr(BatteryLife));
    Add('Battery Full Time: ' + IntToStr(BatteryFullTime));

    Add('*** Memory info ***');
    Add('Physical Memory Available: ' + IntToStr(MemAvailPhysical));
    Add('Total Memory Available: ' + IntToStr(MemAvailTotal));
    Add('Total Page File Size: ' + IntToStr(PageFileTotal));
    Add('Page File Available: ' + IntToStr(PageFileAvail));
    Add('Total Virtual Memory: ' + IntToStr(MemVirtualTotal));
    Add('Virtual Memory Available: ' + IntToStr(MemVirtualAvail));

    Add('*** Video info ***');
    Add('Resolution: ' + VideoResolution);
    Add('Number of colours: ' + FloatToStr(NumberOfColours));

    Add('*** Disk Info - Drive C:***') ;
    Add('Free space on C: ' + IntToStr(DiskFree));
    Add('Free clusters: ' + IntToStr(FreeClusters));
    Add('Sectors per cluster: ' + IntToStr(SectorsPerCluster));
    Add('Bytes per sector: ' + IntToStr(BytesPerSector));
    Add('Total clusters: ' + IntToStr(TotalClusters));

  {Memo1.Lines.Add('*** Processor info ***');
  Memo1.Lines.Add(CRLF + '*** Video info ***');
  Memo1.Lines.Add('Resolution: ' + MyInfo.VideoResolution);
  Memo1.Lines.Add('Number of colours: ' + FloatToStr(MyInfo.NumberOfColours));

  Memo1.Lines.Add(CRLF + '*** Disk Info - Drive C:***') ;
  Memo1.Lines.Add('Free space on C: ' + IntToStr(MyInfo.DiskFree));
  Memo1.Lines.Add('Free clusters: ' + IntToStr(MyInfo.FreeClusters));
  Memo1.Lines.Add('Sectors per cluster: ' + IntToStr(MyInfo.SectorsPerCluster));
  Memo1.Lines.Add('Bytes per sector: ' + IntToStr(MyInfo.BytesPerSector));
  Memo1.Lines.Add('Total clusters: ' + IntToStr(MyInfo.TotalClusters));

  Memo1.Lines.Add('Virtual Memory Available: ' + IntToStr(MyInfo.MemVirtualAvail));}

  end;
end;

procedure TSysInfo.InitInfo;
var
  OsInfo: TOSVERSIONINFO;
  MySysInfo : TSYSTEMINFO;
  MemStat: TMEMORYSTATUS;
  PowerInfo : TSYSTEMPOWERSTATUS;
  WinDir : array[0..MAX_PATH + 1] of char;
  WinSysDir : array[0..MAX_PATH + 1] of char;
  intLen : integer;
begin
 OsInfo.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
 GetVersionEx(OsInfo);

 case OsInfo.dwPlatformId of
  VER_PLATFORM_WIN32s        : fOSName := 'Windows 3.1';
  VER_PLATFORM_WIN32_WINDOWS : begin
                                if (OsInfo.dwMajorVersion>=4) and
                                 (OsInfo.dwMinorVersion>=1) then
                                 fOSName := 'Windows 98'
                                else
                                 fOSName := 'Windows 95';
                               end;
  VER_PLATFORM_WIN32_NT      :
    begin
      Case OsInfo.dwMajorVersion of
        5 : fOSName := 'Windows 2000';
      else
        fOSName := 'Windows NT';
      end;
    end;
 end;

 fOSMajor := OsInfo.dwMajorVersion;
 fOSMinor := OsInfo.dwMinorVersion;
 fBuildNo := LOWORD(OsInfo.dwBuildNumber);
 fServicePack := OsInfo.szCSDVersion;
 try
   fCPUSpeed := GetCPUSpeed;
 except
   fCPUSpeed := 0;
 end;

 GetSystemInfo(MySysInfo);
  Case MySysInfo.dwProcessorType of
    PROCESSOR_INTEL_386     : fProcessorType := 'Intel 80386';
    PROCESSOR_INTEL_486     : fProcessorType := 'Intel 80486';
    PROCESSOR_INTEL_PENTIUM : fProcessorType := 'Intel Pentium';
    PROCESSOR_MIPS_R4000    : fProcessorType := 'MIPS R4000';
    PROCESSOR_ALPHA_21064   : fProcessorType := 'ALPHA 21064';
  else
    fProcessorType := 'Unknown';

  end;

  Case MySysInfo.wProcessorArchitecture of
    PROCESSOR_ARCHITECTURE_INTEL : fProcessorArchitecture := 'Intel';
    PROCESSOR_ARCHITECTURE_MIPS : fProcessorArchitecture := 'MIPS';
    PROCESSOR_ARCHITECTURE_ALPHA  : fProcessorArchitecture := 'Alpha';
    PROCESSOR_ARCHITECTURE_PPC  : fProcessorArchitecture :=  'PPC';
  else
    fProcessorArchitecture := 'Unknown';
  end;

  fNoProcessors := MySysInfo.dwNumberOfProcessors;

  MemStat.dwLength := sizeof(TMEMORYSTATUS);
  GlobalMemoryStatus(MemStat);
  fMemAvailablePhys := Trunc(MemStat.dwAvailPhys/1024);
  fMemTotalPhys := Trunc(MemStat.dwTotalPhys/1024);
  fMemLoad := Trunc(MemStat.dwMemoryLoad/1024);
  fTotalPageFile := Trunc(MemStat.dwTotalPageFile/1024);
  fAvailPageFile := Trunc(MemStat.dwAvailPageFile/1024);;
  fTotalVirtual := Trunc(MemStat.dwTotalVirtual/1024);;
  fAvailVirtual := Trunc(MemStat.dwAvailVirtual/1024);;

  if GetSystemPowerStatus(PowerInfo) then
  begin
    case PowerInfo.ACLineStatus of
      0   : fACLineStatus := 'Off Line';
      1   : fACLineStatus := 'On Line';
      255 : fACLineStatus := 'Unknown';
    end; {Case}

    case PowerInfo.BatteryFlag of
      1   : fBatteryFlag := 'High';
      2   : fBatteryFlag := 'Low';
      4   : fBatteryFlag := 'Critical';
      8   : fBatteryFlag := 'Charging';
      128 : fBatteryFlag := 'No system battery';
      255 : fBatteryFlag := 'Unknown status';
    end; {Case}

    //0 to 100 or 255 if unknown
    fBatteryLifePercent := PowerInfo.BatteryLifePercent;

    //Number of seconds remaining or $FFFFFFFF if unknown
    fBatteryLifeTime := PowerInfo.BatteryLifeTime;

    //Number of seconds battery life when full at charge or $FFFFFFFF if unknown.
    fBatteryFullTime := PowerInfo.BatteryFullLifeTime;
  end; {if}

  FillChar(WinDir, SizeOf(WinDir), #0);
  intLen := GetWindowsDirectory(WinDir, MAX_PATH + 1);
  if intLen > 0 then
    fWinDir := StrPas(WinDir);

  FillChar(WinSysDir, SizeOf(WinSysDir), #0);
  intLen := GetSystemDirectory(WinSysDir, MAX_PATH + 1);
  if intLen > 0 then
    fWinSysDir := StrPas(WinSysDir);

end;

procedure TSysInfo.GetTimeZoneInfo;
{Information about the computer's time zone.}
var
  RetVal : DWORD;
  MyTZInfo : TTimeZoneInformation;
  MySysTime : TSystemTime;
begin
  RetVal := GetTimezoneInformation(MyTZInfo);
  Case RetVal of
    TIME_ZONE_ID_INVALID : begin
                             fTimeZone := 'Invalid Time Zone';
                             fDaylightSaving := False;
                             fDaylightTimeZone := 'Invalid Time Zone.';
                             fDaylightDate := 0;
                             fStandardDate := 0;
                             fBias := 0;
                             fDaylightBias := 0;
                             Exit;
                           end;
    TIME_ZONE_ID_STANDARD : fDaylightSaving := False;
    TIME_ZONE_ID_DAYLIGHT : fDaylightSaving := True;

    TIME_ZONE_ID_UNKNOWN   : begin
                              fTimeZone := 'Unknown Time Zone.';
                              fDaylightSaving := False;
                              fDaylightTimeZone := 'Unknown Time Zone.';
                              fDaylightDate := 0;
                              fStandardDate := 0;
                              fBias := 0;
                              fDaylightBias := 0;
                              Exit;
                            end;
  else
    fTimeZone := 'Error getting Time Zone : ' + IntToStr(RetVal);
    fDaylightSaving := False;
    fDaylightTimeZone := 'Error getting Time Zone.';
    fDaylightDate := 0;
    fStandardDate := 0;
    fBias := 0;
    fDaylightBias := 0;
    Exit;
  end; {Case}

  fTimeZone := MyTZInfo.StandardName;
  fDaylightTimeZone := MyTZInfo.DaylightName;
  fBias := MyTZInfo.Bias;
  fDaylightBias := MyTZInfo.DaylightBias;

  if MyTZInfo.DaylightDate.wYear = 0 then
  //Day in month format
  begin
    with MyTZInfo.DaylightDate do
    begin
      FDaylightDayNo := GetDaylightSavingNo(wDay);
      FDaylightDay := GetDaylightSavingDay(wDayOfWeek);
      FDaylightMonth := GetDaylightSavingMonth(wMonth);
      FDaylightSavingHour := wHour/24;
    end;
    with MyTZInfo.StandardDate do
    begin
      FStandardDayNo := GetDaylightSavingNo(wDay);
      FStandardDay := GetDaylightSavingDay(wDayOfWeek);
      FStandardMonth := GetDaylightSavingMonth(wMonth);
      FStandardHour := wHour/24;
    end;
  end
  else
  begin
  //Absolute format
    MySysTime :=  MyTZInfo.DaylightDate;
    FDaylightDate := SystemTimeToDateTime(MySysTime);
    MySysTime := MyTZInfo.StandardDate;
    FStandardDate := SystemTimeToDateTime(MySysTime);
  end;

end;

procedure TSysInfo.GetFreeSpaceOnDrive(intDrive : integer; var lngFreeSpace : Int64;
  var lngTotalBytes : Int64);
{Returns the amount of space on a drive. Parameter is the logical
 drive number. Used to get info for DriveList.}
var
  lngSectors : DWORD;
  lngBytes : DWORD;
  lngFreeClusters : DWORD;
  lngTotalClusters : DWORD;
  lngUser : Int64;
  lngFree : Int64;
  lngTotal : Int64;
  Drive : PChar;
begin
  LoadDiskFreeEx;
  Drive := PChar(Chr(intDrive + 65) + ':\');
  {There is a bug in the GetDiskFreeSpace function which
   means that it returns incorrect info for drives greater
   than 2 GByte. The GetDiskFreeSpaceEx function present
   in Win 95 OSR2 and NT4 Service pack 2 fixes this.

   I simply try to load the GetDiskFreeSpaceEx function and if
   it fails use GetDiskFreeSpace instead.}
  Case (@GetDiskFreeSpaceEx <> Nil) Of
    True : begin
              If GetDiskFreeSpaceEx(Drive, @lngUser, @lngTotal,
                  @lngFree) then
              begin
                lngFreeSpace := lngUser;
                lngTotalBytes := lngTotal;
              end
              else
              begin
                lngFreeSpace := -1;
                lngTotalBytes := -1;
              end; //if GetDiskFreeSpaceEx
           end;

    False : begin
              if GetDiskFreeSpace(Drive, lngSectors, lngBytes, lngFreeClusters,
                lngTotalClusters) then
              begin
                lngFreeSpace := lngFreeClusters * lngSectors * lngBytes;
                lngTotalBytes := lngTotalClusters  * lngSectors * lngBytes;
              end
              else
              begin
                lngFreeSpace := -1;
                lngTotalBytes := -1;
              end;  //if GetDiskFreeSpace
            end;
  end; {Case}
end;

procedure TSysInfo.GetDiskSpaceFree(Drive : Char);
{Returns space free plus info about cluster sizes, etc. Sets
  properties for drive C:}
var
  lngSectors : Int64;
  lngBytes : Int64;
  lngFreeClusters : Int64;
  lngTotalClusters : Int64;
   intLogicalDrives : integer;
   MyDrive_Rec : TDrive_Rec;
   strDrive : String;
   lngRetVal : Integer;
   lngFreeSpace : Int64;
   lngTotalBytes : Int64;
   intDrive : Integer;
begin
     {Delphi DiskFree uses 0 = Current, 1 = A, etc, so
      need to offset logical drives bitmask by one}
  intDrive := Ord(Drive);
  intDrive := intDrive - 65;

   GetFreeSpaceOnDrive(intDrive, lngFreeSpace, lngTotalBytes);
   if lngFreeSpace <> -1 then
   begin
     fDiskFree := lngFreeSpace;
   end
   else
   begin
     fDiskFree := -1;
   end;


  {if GetDiskFreeSpace(Drive, lngSectors, lngBytes, lngFreeClusters,
   lngTotalClusters) then
  begin
    fDiskFree := lngFreeClusters * lngSectors * lngBytes;
    fFreeClusters := lngFreeClusters;
    fSectorsPerCluster := lngSectors;
    fBytesPerSector := lngBytes;
    fTotalClusters := lngTotalClusters;
  end
  else
    fDiskFree := -1;}
end;

function TSysInfo.GetVolInfo(ADriveRec : TDrive_Rec) : TDrive_Rec;
{Get information such as Volume Name and File System Type for a
 drive. The ADriveRec should be initialised with the letter of
 the drive you want info about.}
var
  Drive : array[0..3] of char;
  VolumeName : array [0..256] of char;
  FSNameBuffer : array [0..256] of char;
  lngVolSN : DWORD;
  lngFlags : DWORD;
  lngMaxComponentLength : DWORD;

begin
  FillChar(Drive, SizeOf(Drive), #0);
  StrLCopy(Drive, PChar(ADriveRec.strDrive), 1);
  Drive[1] := ':';
  Drive[2] := '\';
  FillChar(VolumeName, SizeOf(VolumeName), #0);
  FillChar(FSNameBuffer, SizeOf(FSNameBuffer), #0);

  if GetVolumeInformation(Drive, VolumeName, SizeOf(VolumeName),
    @lngVolSN, lngMaxComponentLength, lngFlags,
    FSNameBuffer, SizeOf(FSNameBuffer)) then
  begin
    with ADriveRec do
    begin
      strVolName := VolumeName;
      lngSerialNo := lngVolSN;
      lngFSFlags := lngFlags;
      strFSName := FSNameBuffer;
    end;

  end;
  Result := ADriveRec;
end;

function TSysInfo.GetDiskDrives : TDriveList;
{Cycle through all connected drives getting info about them.
  Ignores floppies.}
var
   intLogicalDrives : integer;
   I : integer;
   MyDrive_Rec : TDrive_Rec;
   strDrive : String;
   lngRetVal : Integer;
   lngFreeSpace : Int64;
   lngTotalBytes : Int64;
begin
 intLogicalDrives := GetLogicalDrives();
 //Ignore floppy drives
 For I := 2 to 25 do
  begin
     if (intLogicalDrives shr I) And 1 = 1 then
     begin
       {Delphi DiskFree uses 0 = Current, 1 = A, etc, so
        need to offset logical drives bitmask by one}
       strDrive := Chr(I+65);
       GetFreeSpaceOnDrive(I, lngFreeSpace, lngTotalBytes);
       if lngFreeSpace <> -1 then
       begin
         FillChar(MyDrive_Rec, SizeOf(MyDrive_Rec), #0);
         //Get the drive type
         lngRetVal := GetDriveType(PChar(strDrive + ':\'));
         Case lngRetVal of
           DRIVE_REMOVABLE : MyDrive_Rec.strType := 'Removable';
           DRIVE_FIXED     : MyDrive_Rec.strType := 'Fixed';
           DRIVE_REMOTE    : MyDrive_Rec.strType := 'Network';
           DRIVE_CDROM     : MyDrive_Rec.strType := 'CD ROM';
           DRIVE_RAMDISK   : MyDrive_Rec.strType := 'RAM Disk';
         end; //Case
         if lngFreeSpace > 1024 then
           lngFreeSpace := lngFreeSpace div 1024;
         if lngTotalBytes > 1024 then
           lngTotalBytes := lngTotalBytes div 1024;

         MyDrive_Rec.lngFreeSpace := lngFreeSpace;
         MyDrive_Rec.lngTotalSpace := lngTotalBytes;
         MyDrive_Rec.strDrive := strDrive;

         MyDrive_Rec := GetVolInfo(MyDrive_Rec);
         fDriveList.AddDrive(MyDrive_Rec);
       end
       else
       begin
         MyDrive_Rec.lngFreeSpace := -1;
       end;
     end;
  end;
  Result := fDriveList;
end;

procedure TSysInfo.GetVideoInfo;
const
  BITSPIXEL = 12;
  PLANES = 14;
var
  intWidth : integer;
  intHeight : integer;
  lngColors : longint;
  lngScreenHDC : longint;
  extPower : extended;
  extColors : extended;
  Screen : TScreen;
begin

  Screen := TScreen.Create(Self);
  try
    intWidth := Screen.Width;
    intHeight := Screen.Height;

    lngScreenHDC := GetDC(0);
    lngColors := GetDeviceCaps(lngScreenHDC, PLANES);
    extPower := GetDeviceCaps(lngScreenHDC, BITSPIXEL);
    extColors := lngColors * 2;
    extColors := Power(extColors, extPower);
    fNoColors := extColors;
    fVideoRes := IntToStr(intWidth) + ' x ' + IntToStr(intHeight);
  finally
    Screen.Destroy;
  end;
end;

procedure TSysInfo.GetRegisteredInfo;
var
  CurVerKey : PChar;
  OsInfo: TOSVERSIONINFO;
  MyRegistry : TRegistry;
begin
  OsInfo.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
  GetVersionEx(OsInfo);

  case OsInfo.dwPlatformId of
   VER_PLATFORM_WIN32_WINDOWS : CurVerKey := '\SOFTWARE\Microsoft\Windows\CurrentVersion';
   VER_PLATFORM_WIN32_NT      : CurVerKey := '\SOFTWARE\Microsoft\Windows NT\CurrentVersion';
  else
    CurVerKey := nil;
  end;

  MyRegistry := TRegistry.Create;
  try
    MyRegistry.RootKey := HKEY_LOCAL_MACHINE;
    if MyRegistry.OpenKey(CurVerKey, False) then
    begin
      fRegisteredUser := MyRegistry.ReadString('RegisteredOwner');
      fRegisteredCompany := MyRegistry.ReadString('RegisteredOrganization');
      //Only present in Windows 95
      if OSInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
        fCDNo := MyRegistry.ReadString('ProductID');
    end;

  finally
    MyRegistry.Free;
  end;
end;

procedure TSysInfo.GetComputerName;
{Get the computer's network name}
var
  CName : array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
  intLen : DWORD;
begin
  FillChar(CName, SizeOf(CName), #0);
  intLen := MAX_COMPUTERNAME_LENGTH + 1;
  if Windows.GetComputerName(CName, intLen) then
    fComputerName := StrPas(CName)
end;

procedure TSysInfo.GetUserName;
{Get the name of the currently logged in user}
var
  Name : array[0..32] of char;
  Len : DWORD;
begin
  FillChar(Name, SizeOf(Name), #0);
  Len := SizeOf(Name) + 1;

  case WNetGetUser(nil, Name, Len) of
    NO_ERROR:             fUserName := Name;
    ERROR_NOT_CONNECTED:  fUserName := 'Not Connected';
    ERROR_NO_NETWORK:     fUserName := 'No Network';
    else                  fUserName := 'Other Network error';
  end;

end;

function TSysInfo.GetCpuSpeed: Comp;
var
  t: DWORD;
  mhi, mlo, nhi, nlo: DWORD;
  t0, t1, chi, clo, shr32: Comp;
begin
  //Note this uses a Pentium specific instruction,
  //so throws an exception on other processors.
  shr32 := 65536;
  shr32 := shr32 * 65536;

  t := GetTickCount;
  while t = GetTickCount do begin end;
  asm
    DB 0FH
    DB 031H
    mov mhi,edx
    mov mlo,eax
  end;

  while GetTickCount < (t + 1000) do begin end;
  asm
    DB 0FH
    DB 031H
    mov nhi,edx
    mov nlo,eax
  end;

  chi := mhi; if mhi < 0 then chi := chi + shr32;
  clo := mlo; if mlo < 0 then clo := clo + shr32;

  t0 := chi * shr32 + clo;

  chi := nhi; if nhi < 0 then chi := chi + shr32;
  clo := nlo; if nlo < 0 then clo := clo + shr32;

  t1 := chi * shr32 + clo;

  Result := (t1 - t0) / 1E6;
end;

procedure TSysInfo.LoadDiskFreeEx;
{Try and load GetDiskFreeSpaceEx. Returns Nil if it fails}

begin
  if Not DiskSpaceEx_Loaded then
  begin
    DiskSpaceEx_Loaded := True;
    //Note must use full extension for dll to load under NT4.
    Lib := GetModuleHandle('kernel32.dll');
    If Lib <> 0 then
      GetDiskFreeSpaceEx := GetProcAddress(Lib, 'GetDiskFreeSpaceExA')
    else
      GetDiskFreeSpaceEx := Nil;
  end;

end;

initialization
  RegisterClass(TSysInfo);

finalization
  if DiskSpaceEx_Loaded then
    FreeLibrary(lib);

end.
