获取操作系统,CPU,硬盘等信息 vcl

{******************************************************************************}
{******************************************************************************}
{ Jazarsoft SystemInfo Component                                               }
{******************************************************************************}
{                                                                              }
{ VERSION      : 1.0                                                           }
{ AUTHOR       : James Azarja                                                  }
{ CREATED      : 10 July 2000                                                  }
{ WEBSITE      : http://www.jazarsoft.cjb.net/                                 }
{ SUPPORT      : support@jazarsoft.cjb.net                                     }
{ BUG-REPORT   : bugreport@jazarsoft.cjb.net                                   }
{ COMMENT      : comment@jazarsoft.cjb.net                                     }
{ LEGAL        : Copyright (C) 2000 Jazarsoft.                                 }
{                                                                              }
{******************************************************************************}
{ NOTE         :                                                               }
{                                                                              }
{ This code may be used and modified by anyone so long as  this header and     }
{ copyright  information remains intact.                                       }
{                                                                              }
{ The code is provided "as-is" and without warranty of any kind,               }
{ expressed, implied or otherwise, including and without limitation, any       }
{ warranty of merchantability or fitness for a  particular purpose.?          }
{                                                                              }
{ In no event shall the author be liable for any special, incidental,          }
{ indirect or consequential damages whatsoever (including, without             }
{ limitation, damages for loss of profits, business interruption, loss         }
{ of information, or any other loss), whether or not advised of the            }
{ possibility of damage, and on any theory of liability, arising out of        }
{ or in connection with the use or inability to use this software.牋           }
{                                                                              }
{******************************************************************************}
unit SystemInfo;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry, ShlObj, WinSock;
Const
  adr_BiosName              = $FE061;
  adr_BiosCopyright         = $FE091;
  adr_BIOSExtendedInfo      = $FEC71;
  adr_BiosDate              = $FFFF5;
type
  tOnRefreshInfo       = procedure(Sender: TObject;InfoCategory:String) of object;
  tDriveType           = (dtUnknown, dtRootNotFound, dtRemovable, dtFixed, dtRemote, dtCDROM, dtRAMDisk);
  tFileSystemFlag      = (fsCaseIsPreserved,fsCaseSensitive,fsUnicodeStoredOnDisk,fsPersistentAcls,fsFileCompression,fsVolIsCompressed);
  tFileSystem          = Set of TFileSystemFlag;
  TKeyboard = Class(TPersistent)
  private
   FNumLock     : Boolean;
   FScrollLock  : Boolean;
   FCapsLock  : Boolean;
  protected
  public
   constructor Create;
   destructor  Destroy;override;
   procedure   RefreshInfo;
  published
   property Numlock             : Boolean  Read FNumlock          Write FNumlock;
   property ScrollLock          : Boolean  Read FScrollLock          Write FScrollLock;
   property Capslock            : Boolean  Read FCapslock          Write FCapslock;
  end;
  TDisplay = Class(TPersistent)
  private
   FChipType               : String;
   FDACType                : String;
   FRevision               : String;
   FAGP                    : Boolean;
   F3DProcessor            : Boolean;
   FMemory                 : String;
   FSupportedModes         : tstrings;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo(AdapterIndex:Integer);
  published
   property ChipType            : String   Read FChipType     Write FChipType;
   property DACType             : String   Read FDACType      Write FDACType;
   property Revision            : String   Read FRevision     Write FRevision;
   property AGP                 : Boolean  Read FAGP          Write FAGP;
   property Processor3D         : Boolean  Read F3dProcessor  Write F3dProcessor;
   property Memory              : String   Read FMemory       Write FMemory;
   property SupportedModes      : tStrings Read FSupportedModes;
  end;
  TNetwork = Class(TPersistent)
  private
   FNetAdap  : tstrings;
   FNetCli   : tStrings;
   FNetProto : tStrings;
   FLocalIP  : String;
   FLocalHost: String;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property Adapter     : tStrings Read FNetAdap;
   property Clients     : tstrings Read FNetCli;
   property Protocols   : tstrings Read FNetProto;
   property LocalIP     : String Read FLocalIP write FLocalIP;
   property LocalHost   : String Read FLocalHost Write FLocalHost;
  end;
  TDirectX = Class(TPersistent)
  private
   FVersion               : String;
   FDirect3dDrvDesc       : tStrings;
   FDirectMusicDrvDesc    : tStrings;
   FDirectPlayDrvDesc     : tstrings;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property Version  : String Read FVersion Write FVersion;
   property Direct3D : tstrings Read FDirect3dDrvDesc;
   property DirectMusic : tstrings Read FDirectMusicDrvDesc;
   property DirectPlay  : tstrings Read FDirectPlayDrvDesc;
  end;
  TDevice = Class(TPersistent)
  private
   F3DAccel  : tStrings;
   FAdapter  : tStrings;
   FSystem   : tstrings;
   FUSB      : tstrings;
   FPorts    : tStrings;
   FMedia    : tstrings;
   FPrinter  : tStrings;
   FSCSI     : tStrings;
   FModem    : tStrings;
   FMonitor  : tStrings;
   FKeyBoard : tStrings;
   FMouse    : tStrings;
   FCdRom    : tStrings;
   FPCMCIA   : tstrings;
   FInfraRed : tStrings;
   FMultiFun : tStrings;
   FHDC      : tStrings;
   FFDC      : tStrings;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property Accelerators3D : tStrings Read F3dAccel;
   property CdRom  : tStrings Read FCDROM;
   property Adapter: tStrings Read FAdapter;
   property System : tStrings Read FSystem;
   property USB    : tStrings Read FUSB;
   property Ports  : tStrings Read FPorts;
   property Media  : tStrings Read FMedia;
   property Printer: tStrings Read FPrinter;
   property SCSI   : tStrings Read FSCSI;
   property Modem  : tstrings Read FModem;
   property Monitor: tstrings read FMonitor;
   property Keyboard:tStrings Read FKeyBoard;
   property Mouse  : tStrings Read FMouse;
   property PCMCIASocket : tstrings Read FPCMCIA;
   property InfraRed : tStrings Read FInfraRed;
   property MultiFunction : tStrings Read FMultiFun;
   property HardDiskControllers : tStrings Read FHDC;
   property FloppyDiskControllers : tStrings Read FFDC;
  end;
  TLocaleInfo = Class(TPersistent)
  private
   FLang     : String;
   FEngLang  : String;
   FAbbrLang : String;
   FCountry  : String;
   FFCountry : String;
   FAbbrCtry : String;
   FList      : String;
   FMeasure   : String;
   FDecimal   : String;
   FDigit     : String;
   FCurrency  : String;
   FIntlSymbol: String;
   FMonDecSep : String;
   FMonThoSep : String;
   FCurrdigit : String;
   FPCurrMode : String;
   FNCurrMode : String;
   FDate      : String;
   FTime      : String;
   FTimeFormat : String;
   FShortDate  : String;
   FShortDateOrdr : String;
   FLongDateOrdr  : String;
   FTimeFormatSpec: String;
   FYearFormat    : String;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   Procedure RefreshInfo(LocaleID:Cardinal);
  published
   property FullLocalizeLanguage     : String Read Flang Write FLang;
   property FullLanguageEnglishName  : String Read FEngLang Write FEngLang;
   property AbbreviateLanguageName   : String Read FAbbrLang Write FAbbrLang;
   property CountryCode              : String Read FCountry Write FCountry;
   property FullCountryCode          : String Read FFCountry Write FFCountry;
   property AbbreviateCountryCode    : String Read FAbbrCtry Write FAbbrCtry;
   property ListSeparator            : String Read FList Write FList;
   property SystemofMeasurement      : String Read FMeasure Write FMeasure;
   property DecimalSeparator         : String Read FDecimal Write FDecimal;
   property NumberofDecimalDigits    : String Read FDigit Write FDigit;
   property LocalMonetarySymbol      : String Read FCurrency Write FCurrency;
   property InternationalMonetarySymbol : String Read FIntlSymbol Write FIntlSymbol;
   Property CurrencyDecimalSeparator : String Read FMonDecSep Write FMonDecSep;
   property CurrencyThousandSeparator: String Read FMonThoSep write FMonThoSep;
   property CurrencyDecimalDigits    : string Read FCurrDigit Write FCurrdigit;
   property PositiveCurrencyMode     : String Read FPCurrMode Write FPCurrMode;
   property NegativeCurrencyMode     : string Read FNCurrMode Write FNCurrMode;
   property DateSeparator            : string Read FDate Write FDate;
   property TimeSeparator            : string Read FTime Write FTime;
   property TimeFormat               : string Read FTimeFormat Write FTimeFormat;
   property ShortDateFormat          : string Read FShortDate Write FShortDate;
   property ShortDateOrder           : string Read FShortDateOrdr Write FShortDateOrdr;
   property LongDateOrder            : string Read FLongDateOrdr Write FLongDateOrdr;
   property TimeFormatSpecifier      : string Read FTimeFormatSpec Write FTimeFormatSpec;
   property YearFormat               : string Read FYearFormat Write FYearFormat;  
  end;
  TTimeZone = Class(TPersistent)
  private
   FBias             : Integer;
   FStandardName     : string;
   FStandardTime     : TDateTime;
   FDaylightName     : String;
   FDaylightTime     : TDateTime;
   FDayLightBias     : Integer;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property Bias             : Integer read FBias write FBias;
   property StandardName     : string  read FStandardName write FStandardName;
   property StandardTime     : TDateTime  read FStandardTime write FStandardTime;
   property DaylightName     : String  read FDaylightName write FDaylightName;
   property DaylightTime     : TDateTime  read FDaylightTime write FDaylightTime;
   property DayLightBias     : Integer  read FDayLightBias write FDayLightBias;
  end;
  TDirectories = Class(TPersistent)
  private
   FProgramFiles  : String;
   FCommonFiles   : String;
   FMedia         : String;
   FDevice        : String;
   FConfig        : String;
   FOtherDevice   : String;
   FWallpaper     : String;
   FWindows       : String;
   FSystem        : String;
   FTemp          : String;
   { Spesial Folder, Win9x ONLY ! }
   FDesktop       : String;
   FInternet      : String;
   FPrograms      : String;
   FControls      : String;
   FPrinters      : String;
   FPersonal      : String; { My Document }
   FFavorites     : String;
   FStartUp       : String;
   FRecent        : String;
   FSendTo        : String;
   FBitBucket     : String; { Recycle Bin }
   FStartMenu     : String;
   FDesktopDir    : String;
   FDrives        : String; { My Computer }
   FNetWork       : String;
   FNetHood       : String;
   FFonts         : String;
   FTemplates       : String;
   FCommonStartMenu : String; { Startmenu, For all user }
   FcommonPrograms  : String;
   FCommonStartUp   : String;
   FCommonDesktopDir: String;
   FAppData          : String;
   FPrintHood        : String;
   FCommonAltStartUp : String;
   FCommonFavorites  : String;
   FInternetCache    : String;
   FCookies          : String;
   FHistory          : String;
  protected
  public
   constructor Create;
   destructor Destroy;override;
//   procedure RefreshInfo;
  published
   property ProgramFiles : String read FProgramFiles Write FProgramFiles;
   property CommonFiles  : String Read FCommonFiles write FcommonFiles;
   property Media        : String Read FMedia write FMedia;
   property Device       : String Read FDevice write FDevice;
   property Config       : String Read FConfig write FConfig;
   property OtherDevice  : String Read FOtherDevice write FOtherDevice;
   property Wallpaper    : String Read FWallpaper write FWallpaper;
   property Windows      : String Read Fwindows Write FWindows;
   property System       : String read FSystem Write Fsystem;
   property Temp         : String Read FTemp Write FTemp;
   { Spesial Folder, Alphabetical Order }
   property AppData              : String read FAppData Write FAppData;
// property RecycleBin           : String Read FBitBucket Write FBitBucket;
// property CommonAltStartUp     : String Read FCommonAltStartUp Write FCommonAltStartUp;
   property CommonDesktopDir     : String Read FCommonDesktopDir Write FCommonDesktopDir;
// property CommonFavorites      : String Read FCommonFavorites Write FCommonFavorites;
// property CommonFiles          : String Read FCommonFiles Write FCommonFiles;
// property CommonPrograms       : String Read FCommonPrograms Write FCommonPrograms;
// property CommonStartmenu      : String Read FCommonStartmenu Write FCommonStartmenu;
// property CommonStartUp        : String Read FCommonStartUp Write FCommonStartUp;
// property Config               : String read FConfig Write FConfig;
// property Controls             : String read FControls Write FControls;
   property Cookies              : String read FCookies Write FCookies;
   property Desktop              : String read FDesktop Write FDesktop;
   property DesktopDir           : String read FDesktopDir Write FDesktopDir;
// property Drives               : String read FDrives Write FDrives;
   property Favorites            : String read FFavorites Write FFavorites;
   property Fonts                : String read FFonts Write FFonts;
   property History              : String read FHistory Write FHistory;
// property Internet             : String read FInternet Write Finternet;
   property InternetCache        : String read FInternetCache Write FinternetCache;
   property NetHood              : String read FNetHood Write FNetHood;
// property NetWork              : String read FNetWork Write FNetWork;
   property MyDocuments          : String read FPersonal Write FPersonal;
// property Printers             : String Read FPrinters Write FPrinters;
   property PrintHood            : String Read FPrintHood Write FPrintHood;
// property Programs             : String Read Fprograms Write Fprograms;
   property Recent               : String read FRecent Write FRecent;
   property SendTo               : String Read FSendTo Write FSendTo;
   property StartUp              : String Read FStartup write FStartUp;
   property Templates            : String Read FTemplates Write FTemplates;
  end;
  TDisk = Class(TPersistent)
  private
   FDrive                   : String;
   FDriveType               : tDriveType;
   FSerialNumber            : Integer;
   FSerialNumberText        : String;
   FReady                   : Boolean;
   FVolumeLabel             : String;
   FFileSystem              : String;
   FFileSystemFlag          : tFileSystem;
   { Delphi Internal Function }
//  FDiskSize                : String; { In Bytes }
//  FDiskFree                : String; { In Bytes }
   { GetDiskFreeSpace and GetDiskFreeSpaceEx }
   FSectorsPerCluster       : String;
   FBytesPerSector          : String;
   FNumberOfFreeCluster     : String;
   FTotalNumberOfCluster    : String;
   FTotalNumberOfBytes      : String;
   FTotalNumberOfFreeBytes  : String; { Quotas for the calling thread, refer to WINAPI SDK GetDiskFreeSpaceEx }
   FClusterSize             : String;
   FFreeBytes               : String;
   Procedure SetDrive(Drive:String);
  protected
   Procedure GetDiskInfo(Drive:string);
  public
   constructor Create;
   destructor Destroy;override;
   procedure  RefreshInfo;
  protected
  published
   property Drive                   : String Read FDrive Write SetDrive;
   property DriveType               : tDriveType Read FDriveType Write FDriveType;
   property SerialNumber            : Integer Read FSerialNumber Write FSerialNumber;
   property SerialNumberLabel       : String Read FSerialNumberText Write FSerialNumberText;
   property VolumeLabel             : String Read FVolumeLabel Write FVolumeLabel;
   property FileSystem              : string Read FFilesystem Write FFileSystem;
   property FileSystemFlag          : tFilesystem Read FFileSystemFlag Write FFileSystemFlag;
   property DiskReady               : Boolean Read FReady Write FReady;
//   property DiskSize              : String Read FDiskSize Write FDiskSize;
//   property DiskFree              : String Read FDiskFree Write FDiskFree;
   property SectorsPerCluster       : String Read FSectorsPerCluster       write FSectorsPerCluster     ;
   property BytesPerSector          : String read FBytesPerSector          write FBytesPerSector        ;
   property FreeCluster             : String read FNumberOfFreeCluster     write FNumberOfFreeCluster   ;
   property TotalCluster            : String read FTotalNumberOfCluster    write FTotalNumberOfCluster  ;
   property TotalBytes              : String read FTotalNumberOfBytes      write FTotalNumberOfBytes    ;
// property NumberOfFreeBytes       : String read FTotalNumberOfFreeBytes  write FTotalNumberOfFreeBytes;
   property ClusterSize             : String read FClusterSize             Write FClusterSize;
   property FreeBytes               : String read FFreeBytes               Write FFreeBytes;
  end;
  TUser = Class(TPersistent)
  private
   FLocaleInfo       : tLocaleInfo;
   FUserName         : String;
   FUsrLangDefID     : String;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property UserName      : String read FUsername write FUsername;
   property LanguageID    : String Read FUsrLangDefID Write FUsrLangDefID;
   property LocaleInfo    : tLocaleInfo Read FLocaleInfo Write FLocaleInfo;
  end;
  TCPU = Class(TPersistent)
  private
   FProcessorArchitecture : Integer;
   FProcessorCount        : Integer;
   FProcessorLevel        : Integer;
   FProcessorType         : String;
   FProcessorVersion      : String;
   FProcessorRevision     : Integer; { Hi=Maj, Lo=Min }
   FProcessorOEMID        : Integer; { NT Only }
   FFreq                  : String;  { in MHz }
   FCPUID                 : Boolean;
   FVendor                : String;
   { CPU ID Properties }
   FFamily                : integer;
   FStepping              : Integer;
   FModel                 : Integer;
   FType                  : Integer;
   FProcessorID           : tStrings; { Assume your computer has multiple Processor }
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property Architecture  : Integer Read FProcessorArchitecture Write FProcessorArchitecture;
   property Count         : Integer Read FProcessorCount Write FProcessorCount;
   property Level         : Integer Read FProcessorLevel Write FProcessorLevel;
   property Revision      : Integer Read FProcessorRevision Write FProcessorRevision;
   property OEMid         : Integer Read FProcessorOEMid Write FProcessorOEMid;
   Property ProcType      : String Read  FProcessorType  Write FProcessorType;
   Property Version       : String Read  FProcessorVersion  Write FProcessorVersion;
   property Freq          : String Read  FFreq Write FFreq;
   property CPUID         : Boolean Read FCPUID Write FCPUID;
   property Vendor        : String Read FVendor Write FVendor;
   property Family        : Integer Read FFamily Write FFamily;
   property Stepping      : Integer Read FStepping Write FStepping;
   property Model         : Integer Read FModel Write FModel;
   property TypeID        : Integer Read FType Write FType;
   property ProcessorID   : tStrings Read FProcessorID Write FProcessorID;
  end;
  TMemory = Class(TPersistent)
  private
   {  Formula For Usage Memory Calc  :
      100-trunc(Avail/Total*100)   }
   FMemoryLoad     : Byte;
   FTotalPhys      : Integer;{ in Bytes }
   FAvailPhys      : Integer;{ in Bytes }
   FTotalPageFile  : Integer;{ in Bytes }
   FAvailPageFile  : Integer;{ in Bytes }
   FTotalVirtual   : Integer;{ in Bytes }
   FAvailVirtual   : Integer;{ in Bytes }
   FSwapFileSize   : Integer;{ in Bytes }
   FSwapFileUsage  : Integer;{ in % }
   { For more information, about the following properties, see
     Windows API Help, SYSTEM_INFO Struct }
   FPageSize       : Integer;{ ? }
   FAllocGranularity : Integer; { ? }
   { Memory Mapping }
   FMinAppAddr     : Integer;
   FMaxAppAddr     : Integer;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property MaxAppAddress  : Integer Read FMaxAppAddr Write FMaxAppAddr;
   property MinAppAddress  : Integer Read FMinAppAddr Write FMinAppAddr;
   property MemoryLoad     : Byte Read FMemoryLoad Write FMemoryLoad;
   property SwapFileSize   : Integer Read FSwapFileSize Write FSwapFileSize;
   property SwapUsage      : Integer Read FSwapFileUsage Write FSwapFileUsage;
   property PhysicalTotal  : Integer Read FTotalPhys Write FTotalPhys;
   property PhysicalFree   : Integer Read FAvailPhys Write FAvailPhys;
   property PageFileTotal  : Integer Read FTotalPageFile Write FTotalPageFile;
   property PageFileFree   : Integer Read FAvailPageFile Write FAvailPageFile;
   property VirtualTotal   : Integer Read FTotalVirtual Write FTotalVirtual;
   property VirtualFree    : Integer Read FAvailVirtual Write FAvailVirtual;
   property PageSize       : Integer Read FPageSize Write FPagesize;
   property AllocGranularity : Integer Read FAllocGranularity Write FAllocGranularity;
  end;
  TResources = Class(TPersistent)
  private
   FSystemRes : Byte;
   FGDIRes    : Byte;
   FUserRes   : Byte;
  protected
  public
   constructor Create;
   destructor Destroy;override;
//   procedure RefreshInfo;
  published
   property SystemResources : Byte Read FSystemRes Write FSystemRes;
   property GDIResources : Byte Read FGDIRes Write FGDIRes;
   property UserResources : Byte Read FUserRes Write FUserRes;
  end;
  TOperatingSystem = Class(TPersistent)
  private
   FLocaleInfo   : tLocaleInfo;
   FResources    : tResources;
   FDirectories  : tDirectories;
   FTimeZone     : tTimeZone;
   FBootDrive    : String;
   FPlatform     : String;
   FWinBuild     : Integer;
   FWinMajVer    : Integer;
   FWinMinVer    : Integer;
   FCSDVersion   : String;   { Refer to WINAPI SDK, OSVERSIONINFO }
   FWinVersion   : String;
   FSysLangDefID : String;
   FUser         : tUser;
   FRegOwner     : String;
   FRegOrg       : String;
   FProductID    : String;
   FProductKey   : String;
   FProductName  : String;
   FInstallDate  : String;
   FVersion      : String;
   FBootCount    : String;
   FUpdates      : tStrings;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property BootDrive     : String Read FBootDrive Write FBootDrive;
   property LocaleInfo    : tLocaleInfo Read FLocaleInfo Write FLocaleInfo;
   property TimeZone      : TTimeZone Read FTimeZone Write FTimeZone;
   property Directories   : TDirectories Read FDirectories Write FDirectories;
   property Resources     : TResources Read FResources Write FResources;
   property Platform      : String Read FPlatform Write FPlatform;
   property Build         : Integer Read FWinBuild Write FWinBuild;
   property BootCount     : String Read FBootCount Write FBootCount;
   property MajorVer      : Integer Read FWinMajVer Write FWinMajVer;
   property MinorVer      : Integer Read FWinMinVer Write FWinMinVer;
   property LanguageID    : String Read FSysLangDefID Write FSysLangDefID;
   property CSDVersion    : String Read FCSDVersion Write FCSDVersion;
   property RegOwner      : String Read FRegOwner Write FRegOwner;
   property RegOrg        : String Read FRegOrg Write FRegOrg;
   property InstallDate   : String Read FInstallDate Write FInstallDate;
   property ProductID     : String Read FProductID Write FProductID;
   property ProductKey    : String Read FProductKey Write FProductKey;
   property ProductName   : String Read FProductName Write FProductName;
   property SerialNo      : String Read FProductKey Write FProductKey;
   property VersionNumber : String Read FWinVersion Write FWinVersion; { e.g : 4.10 2222.A }
   property User          : tUser Read FUser Write FUser;
   property Version       : String Read FVersion Write FVersion;  { e.g : Windows 95 / Windows 98 }
   property SoftwareUpdates : tStrings Read FUpdates;
  end;
  TDrive = class (TPersistent)
  private
   FAvailDrive : String;
   FDisk       : tDisk;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   Property AvailableDrive : String read FAvailDrive Write FAvailDrive;
   property Disk           : tDisk Read FDisk Write FDisk;
  end;
  TMouse = class (TPersistent)
  private
   FMouseType  : String;
   FDescription : String;
   FAvailable  : Boolean;
   FButtons    : Integer;
   FSwapButton : Boolean;
   FMouseWheel : Boolean;
   FProvider   : String;
   FDoubleClickTime : Integer;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   Property Available : Boolean read FAvailable Write FAvailable;
   property Buttons : Integer Read FButtons Write FButtons;
   property SwapButton : Boolean read FSwapButton Write FSwapButton;
   property MouseWheel : Boolean read FMouseWheel Write FMouseWheel;
   property DoubleClickTime : Integer read FDoubleClickTime Write FDoubleClickTime;
   property MouseType   : String Read FMouseType Write FMouseType;
   property Description : String Read FDescription Write FDescription;
   property Provider    : String Read FProvider Write FProvider;
  end;
  TAPM = class (TPersistent)
  private
   FACLineStatus        : String;
   FBatteryFlag         : String;
   FBatteryLifePercent  : Byte;
   FBatteryLifeTime     : Integer;
   FBatteryFullLifeTime : Integer;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property ACLineStatus : String Read FACLineStatus Write FAcLineStatus;
   property BatteryFlag  : String Read FBatteryFlag Write FBatteryFlag;
   property BatteryLifePercent  : Byte Read FBatteryLifePercent Write FBatteryLifePercent;
   property BatteryLifeTime  : Integer Read FBatteryLifeTime Write FBatteryLifeTime;
   property BatteryFullLifeTime  : Integer Read FBatteryFullLifeTime Write FBatteryFullLifeTime;
  end;
  TWorkstation = class (TPersistent)
  private
   FBIOSName         : String;
   FBIOSDate         : String;
   FBIOSCopyright    : String;
   FBIOSExtendedInfo : String;
   FUserName         : String;
   FComputerName     : String;
   FWorkGroup        : String;
   FComment          : String;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property BIOSName : String read FBiosName Write FBIOSName;
   property BIOSDate : String read FBiosDate Write FBIOSDate;
   property BIOSExtendedInfo : String read FBIOSExtendedInfo Write FBIOSExtendedInfo;
   property BIOSCopyright : String read FBiosCopyright Write FBIOSCopyright;
   property UserName : String read FUsername write FUsername;
   property ComputerName : String read FComputerName Write FComputerName;
   property Workgroup    : String read FWorkGroup Write FWorkGroup;
   property Comment    : String read FComment Write FComment;
  end;
  TSystemInfo = class(TComponent)
  private
   FKeyboard             : tKeyboard;
   FDisplay              : tDisplay;
   FDirectX              : tDirectX;
   FDevice               : TDevice;
   FWorkstation          : TWorkStation;
   FMouse                : TMouse;
   FAPM                  : TAPM;
   FDrive                : TDrive;
   FOS                   : TOperatingSystem;
   FMemory               : TMemory;
   FCPU                  : TCPU;
   FNetwork              : tNetwork;
   FStatus               : String;
   FAutoRefresh          : Boolean;
   FOnStatusChange       : tNotifyEvent;
   FOnRefreshInfo        : tOnRefreshInfo;
   FOnRefreshStart       : tNotifyEvent;
   FOnRefreshFinish      : tNotifyEvent;
   procedure SetAutoRefresh(Value:Boolean);
  protected
    procedure   SetStatus(Status:String);
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    Procedure   RefreshInfo;
  published
    property Device      : TDevice Read FDevice Write FDevice;
    property Workstation : TWorkStation read FWorkStation Write FWorkStation;
    property Mouse       : TMouse Read FMouse Write FMouse;    
    property APM         : TAPM  Read FAPM Write FAPM;    
    property Drives      : TDrive Read FDrive Write FDrive;
    property OS          : tOperatingsystem Read FOS Write FOS;
    property Memory      : tMemory Read FMemory Write FMemory;
    property CPU         : TCPU Read FCPU Write FCPU;
    property DirectX     : tDirectX Read FDirectX Write FDirectX;
    property Network     : tNetwork Read Fnetwork write FNetwork;
    property Display     : tDisplay Read FDisplay Write FDisplay;
    property Keyboard    : tKeyboard Read FKeyboard Write FKeyboard;
    property AutoRefresh : Boolean Read FAutoRefresh Write SetAutoRefresh default False;
    property Status      : String Read FStatus Write FStatus;
    property OnStatusChange : tNotifyEvent Read FOnStatusChange Write FOnStatusChange;
    property OnRefreshInfo  : tOnRefreshInfo Read FOnRefreshInfo Write FOnRefreshInfo;
    property OnRefreshStart : tNotifyEvent Read FOnRefreshStart Write FOnRefreshStart;
    property OnRefreshFinish: tNotifyEvent Read FOnRefreshFinish Write FOnRefreshFinish;
  end;
procedure Register;
implementation
Function GetBiosName : String;
Begin
  try
    Result := String(PChar(Ptr(adr_BiosName)));
  except
    Result := 'NoName';
  end;{try..except}
End;{Function GetBiosName}
Function GetBiosCopyright : String;
Begin
  try
    Result := String(PChar(Ptr(adr_BiosCopyright)));
  except
    Result := 'NoCopyright';
  end;{try..except}
End;{Function GetBiosCopyright}
Function GetBIOSExtendedInfo : String;
Begin
  try
    Result := String(PChar(Ptr(adr_BIOSExtendedInfo)));
  except
    Result := '';
  end;{try..except}
End;{Function GetBIOSExtendedInfo}
Function GetBiosDate : TDateTime;
Var
  RegStr, RegFormat : String;
  RegSeparator      : Char;
Begin
  Result := 0;
  try
    RegStr := String(PChar(Ptr(adr_BiosDate)));
  except
    Exit;
  end;{try..except}
  RegFormat := ShortDateFormat;
  RegSeparator := DateSeparator;
  try
    DateSeparator   := '/';
    try
      ShortDateFormat := 'm/d/y';
      Result := StrToDate(RegStr);
    except
      try
        ShortDateFormat := 'y/m/d';
        Result := StrToDate(RegStr);
      except
      end;
    end;
  finally
    ShortDateFormat := RegFormat;
    DateSeparator   := RegSeparator;
  end;{try..finally}
End;{Function GetBiosDate}
Function GetCurrentComputerName : String;
Var
  Name : PChar;
  Size : DWord;
Begin
  Size := MAX_COMPUTERNAME_LENGTH + 1;
  GetMem(Name, Size);
  try
    GetComputerName(Name, Size);
    Result := Trim(StrPas(Name));
  finally
    FreeMem(Name, Size);
  end;{try..finally}
End;{Function GetCurrentComputerName}
Function GetCurrentUserName : String;
Var
  Name : PChar;
  Size : DWord;
Begin
  Size := SizeOf(ShortString);
  GetMem(Name, Size);
  try
    GetUserName(Name, Size);
    Result := Trim(StrPas(Name));
  finally
    FreeMem(Name, Size);
  end;{try..finally}
End;{Function GetCurrentUserName}
{*************************************************************}
{            ResMeter Component for Delphi 32                 }
{ Version:   1.0                                              }
{ Author:    Aleksey Kuznetsov                                }
{ E-Mail:    info@utilmind.com                                }
{ Home Page: http://www.utilmind.com                          }
{ Created:   June, 30, 1999                                   }
{ Modified:  June, 30, 1999                                   }
{ Legal:     Copyright (c) 1999, UtilMind Solutions           }
{*************************************************************}
const
  GFSR_SystemRes = 0;
  GFSR_GDIRes = 1;
  GFSR_USERRes = 2;
var
  hInst16: THandle;
  SR: Pointer;
function LoadLibrary16(LibraryName: PChar): THandle; stdcall; external kernel32 index 35;
procedure FreeLibrary16(HInstance: THandle); stdcall; external kernel32 index 36;
function GetProcAddress16(Hinstance: THandle; ProcName: PChar): Pointer; stdcall; external kernel32 index 37;
{ QT_Thunk needs a stack frame. }
{$StackFrames On}
{procedure QT_Thunk; cdecl; external kernel32 name 'QT_Thunk';
function GetFreeSysResources(SysRes: Word): Word;
var
  Thunks: Array[0..$20] of Word;
begin
  Thunks[0] := hInst16;
  hInst16 := LoadLibrary16('user.exe');
  if hInst16 < 32 then
    raise Exception.Create('Can''t load USER.EXE!');
  FreeLibrary16(hInst16);
  SR := GetProcAddress16(hInst16, 'GetFreeSystemResources');
  if SR = nil then
    raise Exception.Create('Can''t get address of GetFreeSystemResources!');
  asm
    push SysRes       // push arguments
    mov edx, SR       // load 16-bit procedure pointer
    call QT_Thunk     // call thunk
    mov Result, ax    // save the result
  end;
end;
}
Function GetCPUSpeed: Double;
const
  DelayTime = 500; // measure time in ms
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, 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;
const
ID_BIT  =  $200000;      // EFLAGS ID bit
type
TCPUID  = array[1..4] of Longint;
TVendor  = array [0..11] of char;
function IsCPUIDAvailable : Boolean; register;
asm
PUSHFD              {direct access to flags no possible, only via stack}
  POP     EAX          {flags to EAX}
  MOV     EDX,EAX      {save current flags}
  XOR     EAX,ID_BIT  {not ID bit}
  PUSH    EAX          {onto stack}
  POPFD                {from stack to flags, with not ID bit}
  PUSHFD              {back to stack}
  POP     EAX          {get back to EAX}
  XOR     EAX,EDX      {check if ID bit affected}
  JZ      @exit        {no, CPUID not availavle}
  MOV     AL,True      {Result=True}
@exit:
end;
function GetCPUID : TCPUID; assembler; register;
asm
  PUSH    EBX         {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX     {@Resukt}
  MOV     EAX,1
  DW      $A20F       {CPUID Command}
  STOSD                {CPUID[1]}
  MOV     EAX,EBX
  STOSD               {CPUID[2]}
  MOV     EAX,ECX
  STOSD               {CPUID[3]}
  MOV     EAX,EDX
  STOSD               {CPUID[4]}
  POP     EDI          {Restore registers}
  POP     EBX
end;
function GetCPUVendor : TVendor; assembler; register;
asm
  PUSH    EBX          {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX      {@Result (TVendor)}
  MOV     EAX,0
  DW      $A20F        {CPUID Command}
  MOV     EAX,EBX
  XCHG    EBX,ECX     {save ECX result}
  MOV      ECX,4
@1:
  STOSB
  SHR     EAX,8
  LOOP    @1
  MOV     EAX,EDX
  MOV      ECX,4
@2:
  STOSB
  SHR     EAX,8
  LOOP    @2
  MOV     EAX,EBX
  MOV      ECX,4
@3:
  STOSB
  SHR     EAX,8
  LOOP    @3
  POP     EDI          {Restore registers}
  POP     EBX
end;
Function GetSpesialFolder(Handle:Hwnd;nFolder:Integer):String;
var
PIDL: PItemIDList;
Path: LPSTR;
begin
Result:='';
Path := StrAlloc(MAX_PATH);
SHGetSpecialFolderLocation(Handle, nFolder, PIDL);
if SHGetPathFromIDList(PIDL, Path) then
  Result := StrPas(Path);
// SHGetSpecialFolderPath(Handle,Path,nFolder,False);
// Result:=Path;
StrDispose(Path);
end;
{*************************************************************}
{*************************************************************}
constructor TKeyboard.Create;
Begin
  inherited Create;
//  RefreshInfo;
End;
destructor TKeyboard.Destroy;
Begin
  inherited Destroy;
End;
Procedure TKeyboard.RefreshInfo;
var  Keys: TKeyboardState;
Begin
GetKeyboardState( keys );
FNumLock  := keys[VK_NUMLOCK]=1;
FCapsLock := keys[VK_CAPITAL]=1;
FScrollLock := keys[VK_SCROLL]=1;
End;
constructor TDisplay.Create;
Begin
  inherited Create;
  FSupportedModes:=tStringList.Create;
//  RefreshInfo(0);
End;
destructor TDisplay.Destroy;
Begin
  FsupportedModes.Free;
  inherited Destroy;
End;
Procedure TDisplay.RefreshInfo(AdapterIndex:Integer);
var
  Buf        : array [0..3] of byte;
  I          : Integer;
  DevMode : TDevMode;
Function MsgColorDepth(ColorDepth:Integer):String;
Begin
case ColorDepth of
2 : result:='Grayscale';
4 : result:='16 Colors';
8 : result:='256 Colors';
16: result:='High Colors';
24: result:='True Colors';
End;
End;
Begin
FsupportedModes.Free;
FSupportedModes:=tStringList.Create;
i := 0;
while EnumDisplaySettings(nil,i,Devmode) do begin
  with Devmode do
  Begin
   FSupportedModes.Add(Format('%d x %d - %s',[dmPelsWidth,dmPelsHeight,MsgColorDepth(dmBitsPerPel)]));
   Inc(i);
  end;
End;
with TRegistry.Create do
Try
  RootKey := HKEY_LOCAL_MACHINE;
  If OpenKey('System\CurrentControlSet\Services\Class\Display\'+FormatFloat('0000',AdapterIndex)+'\INFO', False) then
  Begin
   FChipType:=ReadString('ChipType');
   FDACType:=ReadString('DACType');
   FRevision:=ReadString('Revision');
   FMemory:=Inttostr(ReadInteger('VideoMemory'));
   CloseKey;
  End;
  If OpenKey('System\CurrentControlSet\Services\Class\Display\'+FormatFloat('0000',AdapterIndex)+'\3D', False) then
  Begin
   I           := Readbinarydata ('AGP',buf,sizeof(buf));
   FAGP:=(Buf[0]=1);
   I           := Readbinarydata ('3DP',buf,sizeof(buf));
   F3DProcessor:=(Buf[0]=1);
   CloseKey;
  End;
Finally
  Free;
End;
End;
constructor TNetwork.Create;
Begin
  inherited Create;
  FNetProto:=tStringList.Create;
  FNetCli:=tStringList.Create;
  FNetAdap:=tStringList.Create;
//  RefreshInfo;
End;
destructor TNetwork.Destroy;
Begin
  FNetProto.Free;
  FNetCli.Free;
  FNetAdap.Free;
  inherited Destroy;
End;
procedure TNetwork.RefreshInfo;
var
  count:integer;
  wVersionRequested : WORD;
  wsaData : TWSAData;
  p : PHostEnt;
  s : array[0..128] of char;
  p2 : pchar;
begin
{Start up WinSock}
wVersionRequested := MAKEWORD(1, 1);
WSAStartup(wVersionRequested, wsaData);
{Get the computer name}
GetHostName(@s, 128);
p := GetHostByName(@s);
FLocalHost:=p^.h_Name;
{Get the IpAddress}
p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
FLocalIP:=p2;
WSACleanup;
FNetProto.Free;
FNetProto:=tStringList.Create;
FNetCli.Free;
FNetCli:=tStringList.Create;
FNetAdap.Free;
FNetAdap:=tStringList.Create;
with TRegistry.Create do
Try
  RootKey := HKEY_LOCAL_MACHINE;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Net\'+FormatFloat('0000',Count), False) do
  Begin
   FNetAdap.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\NetClient\'+FormatFloat('0000',Count), False) do
  Begin
   FNetCli.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\NetTrans\'+FormatFloat('0000',Count), False) do
  Begin
   FNetProto.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
Finally
  Free;
End;
End;
constructor TDirectX.Create;
Begin
  inherited Create;
  FDirect3dDrvDesc:=tStringList.Create;
  FDirectMusicDrvDesc:=tstringList.Create;
  FDirectPlayDrvDesc:=tstringList.Create;
//  RefreshInfo;
End;
destructor TDirectX.Destroy;
Begin
  FDirect3dDrvDesc.Free;
  FDirectMusicDrvDesc.Free;
  FDirectPlayDrvDesc.Free;
  inherited Destroy;
End;
procedure TDirectX.RefreshInfo;
var Key : tstrings;
    I   : Integer;
Begin
FDirect3dDrvDesc.Free;
FDirect3dDrvDesc:=tStringList.Create;
FDirectMusicDrvDesc.Free;
FDirectMusicDrvDesc:=tstringList.Create;
FDirectPlayDrvDesc.Free;
FDirectPlayDrvDesc:=tstringList.Create;
Key:=tstringList.Create;
with TRegistry.Create do
Try
  RootKey := HKEY_LOCAL_MACHINE;
  if OpenKey('Software\Microsoft\DirectX', False) then
  Begin
   FVersion:=ReadString('Version');
   CloseKey;
  End;
  { Getting Direct3D Driver Description }
  if OpenKey('Software\Microsoft\Direct3D\Drivers', False) then
  Begin
   GetKeynames(Key);
   CloseKey;
  End;
  For I:=0 to Key.count-1 do
  Begin
   if OpenKey('Software\Microsoft\Direct3D\Drivers\'+Key.Strings[I], False) then
   Begin
    FDirect3dDrvDesc.Add(ReadString('Description'));
    CloseKey;
   End;
  end;
  { Getting DirectMusic Description }
  if OpenKey('Software\Microsoft\DirectMusic\SoftwareSynths', False) then
  Begin
   GetKeynames(Key);
   CloseKey;
  End;
  For I:=0 to Key.count-1 do
  Begin
   if OpenKey('Software\Microsoft\DirectMusic\SoftwareSynths\'+Key.Strings[I], False) then
   Begin
    FDirectMusicDrvDesc.Add(ReadString('Description'));
    CloseKey;
   End;
  end;
  { Getting DirectPlay Description }
  if OpenKey('Software\Microsoft\DirectPlay\Services', False) then
  Begin
   GetKeynames(Key);
   CloseKey;
  End;
  For I:=0 to Key.count-1 do
  Begin
   if OpenKey('Software\Microsoft\DirectPlay\Services\'+Key.Strings[I], False) then
   Begin
    FDirectPlayDrvDesc.Add(ReadString('Description'));
    CloseKey;
   End;
  end;
Key.Free;
Finally
  Free;
End;
End;
constructor TDevice.Create;
Begin
inherited Create;
FHDC:=TstringList.Create;
FFDC:=tStringList.create;
FMultiFun:=TstringList.Create;
FInfraRed:=tstringList.create;
FPCMCIA:=tStringList.Create;
FCDROM:=tStringList.Create;
F3dAccel:=tStringList.Create;
FMouse:=tStringList.Create;
FKeyboard:=tStringList.Create;
FModem:=tstringList.Create;
FMonitor:=tstringList.Create;
FSCSI:=tstringList.Create;
FPrinter:=tstringList.Create;
FMedia:=tstringList.Create;
FAdapter:=tStringList.Create;
FSystem:=TStringList.Create;
FUSB:=tStringList.Create;
FPorts:=tStringList.Create;
//  RefreshInfo;
End;
destructor TDevice.Destroy;
Begin
FHDC.Free;
FFDC.Free;;
FMultiFun.Free;
FInfraRed.Free;
FPCMCIA.Free;
FCDROM.Free;
F3dAccel.Free;
FMouse.Free;
FKeyboard.Free;
FModem.Free;
FMonitor.Free;
FSCSI.Free;
FPrinter.Free;
FMedia.Free;
FAdapter.Free;
FSystem.Free;
FUSB.Free;
FPorts.Free;
  inherited Destroy;
End;
procedure TDevice.RefreshInfo;
var Count:Integer;
Begin
FHDC.Free;FHDC:=TstringList.Create;
FFDC.Free;FFDC:=tStringList.create;
FMultiFun.Free;
FMultiFun:=TstringList.Create;
FInfraRed.Free;
FInfraRed:=tstringList.create;
FPCMCIA.Free;
FPCMCIA:=tStringList.Create;
FCDROM.Free;
FCDROM:=tStringList.Create;
F3dAccel.Free;
F3dAccel:=tStringList.Create;
FMouse.Free;
FMouse:=tStringList.Create;
FKeyboard.Free;
FKeyboard:=tStringList.Create;
FModem.Free;
FModem:=tstringList.Create;
FMonitor.Free;
FMonitor:=tstringList.Create;
FSCSI.Free;
FSCSI:=tstringList.Create;
FPrinter.Free;
FPrinter:=tstringList.Create;
FMedia.Free;
FMedia:=tstringList.Create;
FAdapter.Free;
FAdapter:=tStringList.Create;
FSystem.Free;
FSystem:=TStringList.Create;
FUSB.Free;
FUSB:=tStringList.Create;
FPorts.Free;
FPorts:=tStringList.Create;
with TRegistry.Create do
Try
  RootKey := HKEY_LOCAL_MACHINE;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\System\'+FormatFloat('0000',Count), False) do
  Begin
   FSystem.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\USB\'+FormatFloat('0000',Count), False) do
  Begin
   FUSB.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Ports\'+FormatFloat('0000',Count), False) do
  Begin
   FPorts.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Adapter\'+FormatFloat('0000',Count), False) do
  Begin
   FAdapter.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Media\'+FormatFloat('0000',Count), False) do
  Begin
   FMedia.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\SCSIAdapter\'+FormatFloat('0000',Count), False) do
  Begin
   FSCSI.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Printer\'+FormatFloat('0000',Count), False) do
  Begin
   FPrinter.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Mouse\'+FormatFloat('0000',Count), False) do
  Begin
   FMouse.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Monitor\'+FormatFloat('0000',Count), False) do
  Begin
   FMonitor.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Modem\'+FormatFloat('0000',Count), False) do
  Begin
   FModem.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Keyboard\'+FormatFloat('0000',Count), False) do
  Begin
   FKeyboard.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\3D Accelerators\'+FormatFloat('0000',Count), False) do
  Begin
   F3dAccel.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\CDROM\'+FormatFloat('0000',Count), False) do
  Begin
   FCDROM.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\PCMCIA\'+FormatFloat('0000',Count), False) do
  Begin
   FPCMCIA.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\Infrared\'+FormatFloat('0000',Count), False) do
  Begin
   FInfraRed.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\MultiFunction\'+FormatFloat('0000',Count), False) do
  Begin
   FMultiFun.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\HDC\'+FormatFloat('0000',Count), False) do
  Begin
   FHDC.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
  Count:=0;
  While OpenKey('System\CurrentControlSet\Services\Class\FDC\'+FormatFloat('0000',Count), False) do
  Begin
   FFDC.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
   CloseKey;
   Inc(count);
  End;
Finally
  Free;
End;
End;
constructor TLocaleInfo.Create;
Begin
  inherited Create;
//  RefreshInfo;
End;
destructor TLocaleInfo.Destroy;
Begin
  inherited Destroy;
End;
procedure TLocaleInfo.RefreshInfo(LocaleID:Cardinal);
var Buffer : PChar;
    BufLen : Integer;
Begin
BufLen:=255;
GetMem(Buffer,BufLen);
Try
GetLocaleInfo(LocaleID, LOCALE_SLANGUAGE, Buffer, BufLen);
FLang   :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SENGLANGUAGE, Buffer, BufLen);
FEngLang  :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SABBREVLANGNAME, Buffer, BufLen);
FAbbrLang :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_ICOUNTRY, Buffer, BufLen);
FCountry  :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SCOUNTRY, Buffer, BufLen);
FFCountry :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SABBREVCTRYNAME, Buffer, BufLen);
FAbbrCtry :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SLIST, Buffer, BufLen);
FList   :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_IMEASURE, Buffer, BufLen);
FMeasure  :=Buffer;
case FMeasure[1] of
'0' : FMeasure := 'Decimal';
'1' : FMeasure := 'Usa';
end;
GetLocaleInfo(LocaleID, LOCALE_SDECIMAL, Buffer, BufLen);
FDecimal  :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_IDIGITS, Buffer, BufLen);
FDigit  :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SCURRENCY, Buffer, BufLen);
FCurrency :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SINTLSYMBOL, Buffer, BufLen);
FIntlSymbol:=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SMONDECIMALSEP, Buffer, BufLen);
FMonDecSep :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SMONTHOUSANDSEP, Buffer, BufLen);
FMonThoSep :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_ICURRDIGITS, Buffer, BufLen);
FCurrdigit :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_ICURRENCY, Buffer, BufLen);
FPCurrMode :=Buffer;
case FPCurrMode[1] of
'0': FPCurrMode := 'Prefix, no separation';
'1': FPCurrMode := 'Suffix, no separation';
'2': FPCurrMode := 'Prefix, 1-char. separation';
'3': FPCurrMode := 'Suffix, 1-char. separation';
end;
GetLocaleInfo(LocaleID, LOCALE_INEGCURR, Buffer, BufLen);
FNCurrMode :=Buffer;
case FNCurrMode[1] of
'0': FNCurrMode := '$1.1)';
'1': FNCurrMode := '-$1.1';
'2': FNCurrMode := '$-1.1';
'3': FNCurrMode := '$1.1-';
'4': FNCurrMode := '(1.1$)';
'5': FNCurrMode := '-1.1$';
'6': FNCurrMode := '1.1-$';
'7': FNCurrMode := '1.1$-';
'8': FNCurrMode := '-1.1 $ (space before $)';
'9': FNCurrMode := '-$ 1.1 (space after $)';
end;
GetLocaleInfo(LocaleID, LOCALE_SDATE, Buffer, BufLen);
FDate  :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_STIME, Buffer, BufLen);
FTime  :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_STIMEFORMAT, Buffer, BufLen);
FTimeFormat :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SSHORTDATE, Buffer, BufLen);
FShortDate  :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_IDATE, Buffer, BufLen);
FShortDateOrdr :=Buffer;
case FShortDateOrdr[1] of
'0': FShortDateOrdr := 'Month-Day-Year';
'1': FShortDateOrdr := 'Day-Month-Year';
'2': FShortDateOrdr := 'Year-Month-Day';
end;
GetLocaleInfo(LocaleID, LOCALE_ILDATE, Buffer, BufLen);
FLongDateOrdr  :=Buffer;
case FLongDateOrdr[1] of
'0': FLongDateOrdr := 'Month-Day-Year';
'1': FLongDateOrdr := 'Day-Month-Year';
'2': FLongDateOrdr := 'Year-Month-Day';
end;
GetLocaleInfo(LocaleID, LOCALE_ITIME, Buffer, BufLen);
FTimeFormatSpec  :=Buffer;
case FTimeFormatSpec[1] of
'0': FTimeFormatSpec := 'AM / PM 12-hour format';
'1': FTimeFormatSpec := '24-hour format';
end;
GetLocaleInfo(LocaleID, LOCALE_ICENTURY, Buffer, BufLen);
FYearFormat  :=Buffer;
case YearFormat[1] of
'0': YearFormat := 'Abbreviated 2-digit century';
'1': YearFormat := 'Full 4-digit century';
end;
Finally
FreeMem(Buffer,BufLen);
End;
End;
constructor TTimeZone.Create;
Begin
  inherited Create;
//  RefreshInfo;
End;
destructor TTimeZone.Destroy;
Begin
  inherited Destroy;
End;
procedure TTimeZone.RefreshInfo;
var Information:_Time_Zone_Information;
Begin
GetTimeZoneInformation(Information);
with Information do
Begin
  FBias:=Bias;
  FDayLightBias:=DaylightBias;
  FDaylightName:=DaylightName;
  FStandardName:=StandardName;
  FDaylightTime:=DaylightTime;
  FStandardTime:=StandardTime;
End;
End;
constructor TDirectories.Create;
Begin
  inherited Create;
//  RefreshInfo;
End;
destructor TDirectories.Destroy;
Begin
  inherited Destroy;
End;
{procedure TDirectories.RefreshInfo;
Begin
End;
}
constructor TDisk.Create;
Begin
  inherited Create;
  FDrive:='C:';
{  RefreshInfo;
}End;
destructor TDisk.Destroy;
Begin
  inherited Destroy;
End;
procedure TDisk.GetDiskInfo(Drive:String);
var DriveType                : Integer;
//  I                        : Int64;
    vSectorsPerCluster       : Cardinal;
    vBytesPerSector          : Cardinal;
    vNumberOfFreeCluster     : Cardinal;
    vTotalNumberOfCluster    : Cardinal;
    vTotalNumberOfBytes      : Int64;
    vTotalNumberOfFreeBytes  : Int64;    { Quotas for the calling thread }
    vClusterSize             : Cardinal;
    vFreeBytes               : Cardinal;
    MaxFilenameLength,
    FSFlags                  : DWord;
    VolumeLabel,
    FileSystem               : Array[0..$FF] of Char;
begin
DriveType := GetDriveType(PChar(Drive[1]+':\'));
if DriveType in [0,1] then Exit;
Case DriveType of
0 : FDriveType:=dtUnknown;
1 : FDriveType:=dtRootNotFound;
DRIVE_REMOVABLE : FDriveType:=dtRemovable;
DRIVE_FIXED     : FDriveType:=dtFixed;
DRIVE_REMOTE    : FDriveType:=dtRemote;
DRIVE_CDROM     : FDriveType:=dtCdrom;
DRIVE_RAMDISK   : FDriveType:=dtRAMDISK;
End;
FDrive:=Drive;
If  GetVolumeInformation(PChar(Drive[1] + ':\'), @VolumeLabel, SizeOf(VolumeLabel),
@FSerialNumber, MaxFilenameLength, FSFlags, @FileSystem, SizeOf(FileSystem)) then
Begin
  FVolumeLabel:=VolumeLabel;
  FFileSystem:=FileSystem;
  FFileSystemFlag:=[];
  If (FSFlags and FS_CASE_IS_PRESERVED)=FS_CASE_IS_PRESERVED then
  FFileSystemFlag:=FFileSystemFlag+[fsCaseIsPreserved];
  If (FSFlags and FS_CASE_SENSITIVE)=FS_CASE_SENSITIVE then
  FFileSystemFlag:=FFileSystemFlag+[fsCaseSensitive];
  If (FSFlags and FS_UNICODE_STORED_ON_DISK)=FS_UNICODE_STORED_ON_DISK then
  FFileSystemFlag:=FFileSystemFlag+[fsUnicodeStoredOnDisk];
  If (FSFlags and FS_PERSISTENT_ACLS)=FS_FILE_COMPRESSION then
  FFileSystemFlag:=FFileSystemFlag+[fsFileCompression];
  If (FSFlags and FS_PERSISTENT_ACLS)=FS_VOL_IS_COMPRESSED then
  FFileSystemFlag:=FFileSystemFlag+[fsVolIsCompressed];
  FSerialNumberText := IntToHex(HiWord(FSerialNumber), 4) + '-' + IntToHex(LoWord(FSerialNumber), 4);
End;
FReady:=(SysUtils.DiskSize(Ord(Drive[1])-Ord('A')+1)<>-1);
If Not FReady then Exit; { Keep it silent }
{ Delphi Codes
  I:=SysUtils.DiskSize(Ord(Drive[1])-Ord('A')+1);
If I<>-1 then
  FDiskSize:=Inttostr(I) else FDiskSize:='drive invalid';
I:=SysUtils.DiskFree(Ord(Drive[1])-Ord('A')+1);
If I<>-1 then
  FDiskFree:=Inttostr(I) else FDiskFree:='drive invalid';
}
if GetDiskFreeSpace(PChar(Drive[1]+':\'), vSectorsPerCluster,
                     vBytesPerSector, vNumberOfFreeCluster,
                     vTotalNumberOfCluster ) then
begin
  vClusterSize := vSectorsPerCluster * vBytesPerSector;
End;
// this function works on Win95 Osr2 or later, Win98, NT 4.0 all version
if NOT GetDiskFreeSpaceEx(PChar(Drive[1]+':\'), vTotalNumberOfFreeBytes, vTotalNumberOfBytes, @vFreeBytes) then begin
  vFreeBytes          := vClusterSize * vNumberOfFreeCluster;
  vTotalNumberOfBytes := vClusterSize * vTotalNumberOfCluster;
end;
FSectorsPerCluster       :=IntToStr(vSectorsPercluster);
FBytesPerSector          :=IntToStr(vBytesPerSector);
FNumberOfFreeCluster     :=IntToStr(vNumberOfFreeCluster);
FTotalNumberOfCluster    :=IntToStr(vTotalNumberOfcluster);
FTotalNumberOfBytes      :=IntToStr(vTotalNumberOfBytes);
FTotalNumberOfFreeBytes  :=IntToStr(vTotalNumberOfFreeBytes);
FClusterSize             :=IntToStr(vClusterSize);
FFreeBytes               :=IntToStr(vFreeBytes);
End;
Procedure TDisk.SetDrive(Drive:String);
Begin
If (Drive<>FDrive) then
Begin
  GetDiskInfo(Drive);
End;
End;
procedure TDisk.RefreshInfo;
Begin
GetDiskInfo(FDrive);
End;
constructor TUser.Create;
Begin
  inherited Create;
  FLocaleInfo:=tLocaleInfo.Create;
//  RefreshInfo;
End;
destructor TUser.Destroy;
Begin
  FLocaleInfo.Free;
  inherited Destroy;
End;
procedure TUser.RefreshInfo;
Begin
FLocaleInfo.RefreshInfo(LOCALE_USER_DEFAULT);
FUsrLangDefID   := Format('$%.4x',[GetUserDefaultLangID]);
FUsername:=GetCurrentUsername;
End;
constructor TCPU.Create;
Begin
  inherited Create;
  FProcessorID:=tStringList.Create;
//  RefreshInfo;
End;
destructor TCPU.Destroy;
Begin
  FProcessorID.Free;
  inherited Destroy;
End;
procedure TCPU.RefreshInfo;
var SI : _SYSTEM_INFO;
    CPUID : tCPUID;
    I : Integer;
    Count : Integer;
Begin
GetSystemInfo(SI);
With SI do
Begin
  FProcessorArchitecture:=wProcessorArchitecture;
  FProcessorCount:=dwNumberOfProcessors;
  FProcessorLevel:=wProcessorLevel;
  FProcessorRevision:=wProcessorRevision;
  FProcessorVersion := Format('Level %d  Rev. %d.%d',
  [wProcessorLevel, hi(wProcessorRevision), lo(wProcessorRevision)]);
  case dwProcessorType of
   386       : FProcessorType := 'Intel 386';
   486       : FProcessorType := 'Intel 486';
   586       : FProcessorType := 'Intel Pentium';
   4000      : FProcessorType := 'MIPS RISC 4000';
   21064     : FProcessorType := 'ALPHA 21064';
  else FProcessorType:='Unknown';
  end;
  FProcessorOEMid:=dwOEMid;
End;
{ Meassuring CPU Speed }
FFreq:=Format('%f', [GetCPUSpeed]);
FCPUID:=IsCPUIDAvailable;
If FCPUID then
Begin
  For I := Low(CPUID) to High(CPUID)  do CPUID[I] := -1;
  CPUID  := GetCPUID;
  FType :=CPUID[1] shr 12 and 3;
  FFamily:=CPUID[1] shr 8 and $f;
  FModel:=CPUID[1] shr 4 and $f;
  FStepping:=CPUID[1] and $f;
  FVendor:=GetCPUVendor;
End;
FProcessorID.Free;
FProcessorID:=tStringList.create;
with TRegistry.Create do
Try
  RootKey := HKEY_LOCAL_MACHINE;
  For Count:= 0 to FProcessorCount-1 do
  if OpenKey('Hardware\Description\System\CentralProcessor\'+Inttostr(count), False) then
  Begin
   If ValueExists('Identifier') then FProcessorID.Add(ReadString('Identifier'));
   CloseKey;
  End;
Finally
  Free;
End;
End;
constructor TMemory.Create;
Begin
  inherited Create;
//  RefreshInfo;
End;
destructor TMemory.Destroy;
Begin
  inherited Destroy;
End;
procedure TMemory.RefreshInfo;
var MS    : TMemoryStatus;
    SI    : _System_Info;
Begin
MS.dwLength:=SizeOf(MS);
GlobalMemoryStatus(MS);
With MS do
Begin
  FMemoryLoad:=dwMemoryLoad;
  FTotalPhys:=dwTotalPhys;
  FAvailPhys:=dwAvailPhys;
  FTotalVirtual:=dwTotalVirtual;
  FAvailVirtual:=dwAvailVirtual;
  FTotalPageFile:=dwTotalPageFile;
  FAvailPageFile:=dwAvailPageFile;
  FSwapFileSize    := Trunc((dwTotalPageFile-dwAvailPageFile));
  FSwapFileUsage   := 100-trunc(dwAvailPageFile/dwTotalPageFile*100);
End;
GetSystemInfo(SI);
With SI do
Begin
  FPageSize:=dwPageSize;
  FAllocGranularity:=dwAllocationGranularity;
  FMinAppAddr:=LongInt(lpMinimumApplicationAddress);
  FMaxAppAddr:=LongInt(lpMaximumApplicationAddress);
End;
End;
constructor TResources.Create;
Begin
  inherited Create;
//  RefreshInfo;
End;
destructor TResources.Destroy;
Begin
  inherited Destroy;
End;
{
procedure TResources.RefreshInfo;
Begin
FSystemRes:=GetFreeSysResources(GFSR_SystemRes); // In Percent
FGDIRes := GetFreeSysResources(GFSR_GDIRes); // In Percent
FUserRes := GetFreeSysResources(GFSR_USERRes); // In Percent
End;
}
constructor TOperatingSystem.Create;
Begin
  inherited Create;
  FResources  :=tResources.Create;
  FDirectories:=tDirectories.Create;
  FUser       :=tUser.Create;
  FTimeZone   :=tTimeZone.Create;
  FLocaleInfo:=tLocaleInfo.Create;
  FUpdates:=tStringList.Create;
//  RefreshInfo;
End;
destructor TOperatingSystem.Destroy;
Begin
  FUpdates.Free;
  FLocaleInfo.Free;
  FResources.Free;
  FTimeZone.Free;
  FUser.Free;
  FDirectories.Free;
  inherited Destroy;
End;
procedure TOperatingSystem.RefreshInfo;
var OS         : tOSVERSIONINFO;
    CurRegKey  : PChar;
    Buf        : array [0..3] of byte;
    I          : Integer;
    PathArray  : array [0..255] of char;
    WinH       : Hwnd;
Begin
FUpdates.Free;
FUpdates:=tStringList.Create;
FLocaleInfo.RefreshInfo(LOCALE_USER_DEFAULT);
FUser.RefreshInfo;
FTimeZone.RefreshInfo;
// FResources.RefreshInfo;
with TRegistry.Create do
Try
  RootKey := HKEY_LOCAL_MACHINE;
  If  OpenKey('Software\Microsoft\Windows\CurrentVersion\Setup',False) then
  Begin
   FBootDrive:=ReadString('BootDir');
   CloseKey;
  End;
  If  OpenKey('Software\Microsoft\Windows\CurrentVersion\Setup\Updates',False) then
  Begin
   GetValuenames(FUpdates);
   For I:=0 to FUpdates.Count-1 do
   Begin
    if (FUpdates.Strings[I]='') or
       (FUpdates.Strings[I]='CLSID') then
    FUpdates.Strings[I]:='' else
    FUpdates.Strings[I]:=FUpdates.Strings[I]+
                         Format(' (%s)',[ ReadString( FUpdates.Strings[I] ) ]);
   End;
   I:=0;
   Repeat
    If FUpdates.Strings[I]='' then FUpdates.Delete(I) else
    Inc(I);
   Until I=FUpdates.Count-1;
   CloseKey;
  End;
Finally
  Free;
End;
OS.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
GetVersionEx(OS);
case OS.dwPlatformId of
  VER_PLATFORM_WIN32s        : FPlatform := 'Windows 3.1x/32s';
  VER_PLATFORM_WIN32_WINDOWS : FPlatform := 'Windows 95';
  VER_PLATFORM_WIN32_NT       : FPlatform := 'Windows NT';
else
  FPlatForm:='Unknown'; { For Future .... }
end;
with OS do
  begin
   FWinBuild      := LOWORD(dwBuildNumber);
   FWinMajVer     :=dwMajorVersion;
   FWinMinVer     :=dwMinorVersion;
   FCSDVersion    :=szCSDVersion;
   FWinVersion    :=Format('%d.%d (%d.%s)',
   [dwMajorVersion, dwMinorVersion,(dwBuildNumber and $FFFF), szCSDVersion]);
  end;
FSysLangDefID:=Format('$%.4x',[GetSystemDefaultLangID]);
{ Getting Registration Info ... }
case OS.dwPlatformId of
  VER_PLATFORM_WIN32_WINDOWS : CurRegKey := '\SOFTWARE\Microsoft\Windows\CurrentVersion';
  VER_PLATFORM_WIN32_NT      : CurRegKey := '\SOFTWARE\Microsoft\Windows NT\CurrentVersion';
  else  CurRegKey := nil;
end;
with TRegistry.Create do
Try
  RootKey := HKEY_LOCAL_MACHINE;
  if OpenKey(CurRegKey, False) then
  Begin
   FRegOwner   := ReadString('RegisteredOwner');
   FRegOrg     := ReadString('RegisteredOrganization');
   FProductID  := ReadString('ProductID');
   FProductKey := ReadString('ProductKey');
   FProductName:= ReadString('ProductName');
   I           := Readbinarydata ('FirstInstallDateTime',buf,sizeof(buf));
   FVersion    := ReadString('Version');
  //=================================================================================================
  //操作版本失效 cactus123456
  // FInstallDate:=DateTimeToStr(FileDateToDateTime(buf[0]+buf[1]*256+buf[2]*65535+buf[3]*16777216));
   FBootCount  := ReadString('BootCount');
   With FDirectories do
   Begin
    FCommonFiles      :=ReadString('CommonFilesDir');
    FProgramFiles     :=ReadString('ProgramFilesDir');
    FDevice           :=ReadString('DevicePath');
    FOtherDevice      :=ReadString('OtherDevicePath');
    FMedia            :=ReadString('MediaPath');
    FConfig           :=ReadString('ConfigPath');
    FWallpaper        :=ReadString('WallPaperDir');
    FillChar(PathArray, SizeOf(PathArray), #0);
    GetWindowsDirectory(PathArray,255);
    FWindows :=PathArray;
    FillChar(PathArray, SizeOf(PathArray), #0);
    // ExpandEnvironmentStrings('%TEMP%', PathArray, 255);
    { Much Saver, Just use WinAPI Function }
    GetTempPath(255,@PathArray);
    FTemp := PathArray;
    { Kill the Backslash }
    If FTemp[Length(FTemp)]='\' then
     Delete(Ftemp,length(FTemp),1);
    FillChar(PathArray, SizeOf(PathArray), #0);
    GetSystemDirectory(@PathArray,255);
    FSystem:=PathArray;
    WinH:=GetDesktopWindow;
    FAppData               :=GetSpesialFolder(WinH,CSIDL_APPDATA);
    FCommonDesktopDir      :=GetSpesialFolder(WinH,CSIDL_COMMON_DESKTOPDIRECTORY);
    FCommonAltStartUp      :=GetSpesialFolder(WinH,CSIDL_COMMON_ALTSTARTUP);
    FBitBucket             :=GetSpesialFolder(WinH,CSIDL_BITBUCKET);
    FCommonPrograms        :=GetSpesialFolder(WinH,CSIDL_COMMON_PROGRAMS);
    FCommonStartMenu       :=GetSpesialFolder(WinH,CSIDL_COMMON_STARTMENU);
    FCommonStartup         :=GetSpesialFolder(WinH,CSIDL_COMMON_STARTUP);
    FCommonFavorites       :=GetSpesialFolder(WinH,CSIDL_COMMON_FAVORITES);
    FCookies               :=GetSpesialFolder(WinH,CSIDL_COOKIES);
    FControls              :=GetSpesialFolder(WinH,CSIDL_CONTROLS);
    FDesktop               :=GetSpesialFolder(WinH,CSIDL_DESKTOP);
    FDesktopDir            :=GetSpesialFolder(WinH,CSIDL_DESKTOPDIRECTORY);
    FFavorites             :=GetSpesialFolder(WinH,CSIDL_FAVORITES);
    FDrives                :=GetSpesialFolder(WinH,CSIDL_DRIVES);
    FFonts                 :=GetSpesialFolder(WinH,CSIDL_FONTS);
    FHistory               :=GetSpesialFolder(WinH,CSIDL_HISTORY);
    FInternet              :=GetSpesialFolder(WinH,CSIDL_INTERNET);
    FInternetCache         :=GetSpesialFolder(WinH,CSIDL_INTERNET_CACHE);
    FNetWork               :=GetSpesialFolder(WinH,CSIDL_NETWORK);
    FNetHood               :=GetSpesialFolder(WinH,CSIDL_NETHOOD);
    FPersonal              :=GetSpesialFolder(WinH,CSIDL_PERSONAL);
    FPrintHood             :=GetSpesialFolder(WinH,CSIDL_PRINTHOOD);
    FPrinters              :=GetSpesialFolder(WinH,CSIDL_PRINTERS);
    Fprograms              :=GetSpesialFolder(WinH,CSIDL_PROGRAMS);
    FRecent                :=GetSpesialFolder(WinH,CSIDL_RECENT);
    FSendTo                :=GetSpesialFolder(WinH,CSIDL_SENDTO);
    FStartMenu             :=GetSpesialFolder(WinH,CSIDL_STARTMENU);
    FStartUp               :=GetSpesialFolder(WinH,CSIDL_STARTUP);
    FTemplates             :=GetSpesialFolder(WinH,CSIDL_TEMPLATES);
   End;
   CloseKey;
  End;
Finally
  Free;
End;
End;
constructor TDrive.Create;
Begin
  inherited Create;
  FDisk:=tDisk.Create;
//  RefreshInfo;
End;
destructor TDrive.Destroy;
Begin
  FDisk.Free;
  inherited Destroy;
End;
procedure TDrive.RefreshInfo;
var DriveChar:Char;
    DriveType:Integer;
    CurrDrive:String;
Begin
FDisk.RefreshInfo;
FAvailDrive:='';
For DriveChar:='A' to 'Z' do
begin
  CurrDrive := DriveChar + ':\';
  DriveType := GetDriveType(PChar(CurrDrive));
  if DriveType in [0,1] then Continue;                     // Invalid drive specification
  FAvailDrive:=FAvailDrive+DriveChar;
End;
End;
constructor TMouse.Create;
Begin
  inherited Create;
//  RefreshInfo;
End;
destructor TMouse.Destroy;
Begin
  inherited Destroy;
End;
procedure TMouse.RefreshInfo;
Begin
  FAvailable:=Boolean(GetSystemMetrics(SM_MOUSEPRESENT));
  If Not Favailable then Exit;
  FButtons:=GetSystemMetrics(SM_CMOUSEBUTTONS);
  FSwapButton:=Boolean(GetSystemMetrics(SM_SWAPBUTTON));
  FMouseWheel:=Boolean(GetSystemMetrics(SM_MOUSEWHEELPRESENT));
  FDoubleClickTime:=GetDoubleClickTime;
  with TRegistry.Create do
  Try
   RootKey := HKEY_LOCAL_MACHINE;
   { Assume all Computer only have 1 mouse }
   if OpenKey('System\CurrentControlSet\Services\Class\Mouse\0000', False) then
   Begin
    FMouseType:=ReadString('MouseType');
    FDescription:=ReadString('DriverDesc');
    FProvider:=ReadString('ProviderName');
    CloseKey;
   End;
  Finally
   Free;
  End;
End;
constructor TAPM.Create;
Begin
  inherited Create;
//  RefreshInfo;
End;
destructor TAPM.Destroy;
Begin
  inherited Destroy;
End;
procedure TAPM.RefreshInfo;
var
SystemPowerstatus:_System_Power_Status;
Begin
GetSystemPowerStatus(SystemPowerStatus);
Case SystemPowerStatus.ACLineStatus  of
0   :  FAcLineStatus:='Offline';
1   :  FAcLineStatus:='Online';
255 :  FAcLineStatus:='Unknown Status';
End;
Case SystemPowerStatus.BatteryFlag  of
1   :  FBatteryFlag:='High';
2   :  FBatteryFlag:='Low';
4   :  FBatteryFlag:='Critical';
8   :  FBatteryFlag:='Charging';
128 :  FBatteryFlag:='No System Battery';
255 :  FBatteryFlag:='Unknown Status';
End;
FBatteryLifePercent:=SystemPowerStatus.BatteryLifePercent;
FBatteryLifeTime:=SystemPowerStatus.BatteryLifeTime;
FBatteryFullLifeTime:=SystemPowerStatus.BatteryFullLifeTime;
End;
constructor TWorkStation.Create;
Begin
  inherited Create;
//  RefreshInfo;
End;
destructor TWorkstation.Destroy;
Begin
  inherited Destroy;
End;
procedure TWorkstation.RefreshInfo;
Begin
  FBIOSName:=GetBIOSName;
  FBIOSDate:=DateTimeToStr(GetBIOSDate);
  FBIOSCopyright:=GetBIOSCopyright;
  FBIOSExtendedInfo:=GetBIOSExtendedInfo;
  FUsername:=GetCurrentUsername;
  FComputerName:=GetCurrentComputerName;
  with TRegistry.Create do
  Try
   RootKey := HKEY_LOCAL_MACHINE;
   LazyWrite:=False;
   if OpenKey('System\CurrentControlSet\Services\VxD\VNETSUP', False) then
   Begin
    If ValueExists('Workgroup') then FWorkgroup:=ReadString('Workgroup');
    If ValueExists('Comment') then FComment:=ReadString('Comment');
   CloseKey;
   End;
  Finally
   Free;
  End;
End;
constructor TSystemInfo.Create(AOwner: TComponent);
Begin
  inherited Create(AOwner);
  FWorkStation:=tWorkStation.Create;
  FMouse:=tMouse.Create;
  FAPM:=tAPM.Create;
  FDrive:=TDrive.Create;
  FOS:=tOperatingSystem.Create;
  FMemory:=tMemory.create;
  FDevice:=tDevice.Create;
  FDirectX:=tDirectX.Create;
  FCPU:=tCPU.Create;
  FNetwork:=tNetWork.Create;
  FDisplay:=tDisplay.Create;
  FKeyboard:=tKeyboard.Create;
  Status:='Need to be refresh';
  If FAutoRefresh then RefreshInfo;
End;
destructor TSystemInfo.Destroy;
Begin
  inherited Destroy;
  FNetwork.Free;
  FDevice.Free;
  FDirectX.Free;
  FWorkstation.Free;
  FOS.Free;
  FMemory.Free;
  FMouse.Free;
  FAPM.Free;
  FDrive.Free;
  FCPU.Free;
  FDisplay.Free;
  FKeyboard.Free;
End;
procedure tSystemInfo.SetStatus(Status:String);
begin
FStatus:=Status;
If Assigned(FOnStatusChange) then FOnStatusChange(Self);
End;
Procedure tSystemInfo.RefreshInfo;
var Start : Integer;
    H,M,S : Integer;
Procedure TickToTime(Tick:Integer;Var Hour, Minute, Sec : Integer);
Begin
Tick:=Tick div 1000;
Hour:=(Tick div 3600);
Minute:=(Tick mod 3600) div 60;
Sec:=((Tick mod 3600) mod 60);
End;
Begin
SetStatus('Refreshing Info Start at '+DateTimeToStr(Now));
If Assigned(FOnRefreshStart) then FOnRefreshStart(Self);
Start:=GetTickCount;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Operating System');
FOS.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Keyboard');
FKeyboard.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Display');
FDisplay.RefreshInfo(0);
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Network');
FNetwork.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'DirectX');
FDirectX.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Device');
FDevice.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'CPU');
FCPU.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Memory');
FMemory.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Mouse');
FMouse.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Drive');
FDrive.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Mouse');
FMouse.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'APM');
FAPM.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Workstation');
FWorkStation.RefreshInfo;
If Assigned(FOnRefreshFinish) then FOnRefreshFinish(Self);
SetStatus('Refreshing Info Finish at '+DateTimeToStr(Now));
SetStatus(Format('Refreshing time %d ms',[GetTickCount-Start]));
End;
procedure tSystemInfo.SetAutoRefresh(Value:Boolean);
Begin
If (Value<>FAutoRefresh) then
Begin
  FAutoRefresh:=Value;
  If Value then RefreshInfo;
End;
End;
procedure Register;
begin
  RegisterComponents('Jazarsoft', [TSystemInfo]);
end;
end.


发表评论

电子邮件地址不会被公开。 必填项已用*标注

− 3 = 1