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

发布时间:2016-12-7 16:42:15 编辑:www.fx114.net 分享查询网我要评论
本篇文章主要介绍了"获取操作系统,CPU,硬盘等信息",主要涉及到获取操作系统,CPU,硬盘等信息方面的内容,对于获取操作系统,CPU,硬盘等信息感兴趣的同学可以参考一下。

作者 : qi_jianzhou 标题 : 获取操作系统,CPU,硬盘等信息 关键字: 分类 : Delphi 技巧/技术 密级 : 公开   (评分: , 回复: 0, 阅读: 148) {******************************************************************************} {******************************************************************************} { Jazarsoft SystemInfo Component                        } {******************************************************************************} {                                       } { VERSION   : 1.0                              } { AUTHOR    : James Azarja                         } { CREATED   : 10 July 2000                         } { WEBSITE   : http://www.jazarsoft.cjb.net/                 } { SUPPORT   : [email protected]                   } { BUG-REPORT  : [email protected]                  } { COMMENT   : [email protected]                   } { 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:  [email protected]                } { 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   [email protected]}  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   [email protected] (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. 2005-8-12 12:56:34   发表评语&raquo;&raquo;&raquo;   2005-8-12 12:57:57  调用实例unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls,SystemInfo; type  TForm1 = class(TForm)   Memo1: TMemo;   Button1: TButton;   procedure Button1Click(Sender: TObject);  private   { Private declarations }   FOperatingSystem:TOperatingSystem;  public   { Public declarations }  end; var  Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var  FTCPU:TCPU;  FTDisk:TDisk; begin  memo1.Lines.Clear;  FOperatingSystem:=TOperatingSystem.Create;  FOperatingSystem.RefreshInfo;  memo1.Lines.Add('FOperatingSystem.Platform: '+FOperatingSystem.Platform);  memo1.Lines.Add('FOperatingSystem.BootCount: '+FOperatingSystem.BootCount);  memo1.Lines.Add('FOperatingSystem.BootDrive: '+FOperatingSystem.BootDrive);  memo1.Lines.Add('FOperatingSystem.LanguageID: '+FOperatingSystem.LanguageID);  memo1.Lines.Add('FOperatingSystem.ProductID: '+FOperatingSystem.ProductID);  memo1.Lines.Add('FOperatingSystem.ProductKey: '+FOperatingSystem.ProductKey);  memo1.Lines.Add('FOperatingSystem.ProductName: '+FOperatingSystem.ProductName);  memo1.Lines.Add('FOperatingSystem.RegOwner: '+FOperatingSystem.RegOwner);  memo1.Lines.Add('FOperatingSystem.RegOrg: '+FOperatingSystem.RegOrg);  memo1.Lines.Add('FOperatingSystem.InstallDate: '+FOperatingSystem.InstallDate);  memo1.Lines.Add('FOperatingSystem.SerialNo: '+FOperatingSystem.SerialNo);  memo1.Lines.Add('FOperatingSystem.VersionNumber: '+FOperatingSystem.VersionNumber);  memo1.Lines.Add('FOperatingSystem.Version: '+FOperatingSystem.Version);  memo1.lines.Add('FOperatingSystem.Build: '+inttostr( FOperatingSystem.Build));  memo1.lines.Add('FOperatingSystem.MajorVer: '+inttostr( FOperatingSystem.MajorVer));  memo1.lines.Add('FOperatingSystem.MinorVer: '+inttostr( FOperatingSystem.MinorVer));  memo1.Lines.Add('========================================');   FTCPU:=TCPU.Create;   FTCPU.RefreshInfo;   memo1.lines.Add('FTCPU.ProcType: '+FTCPU.ProcType);   memo1.lines.Add('FTCPU.Version: '+FTCPU.Version);   memo1.lines.Add('FTCPU.Freq: '+FTCPU.Freq);   memo1.lines.Add('FTCPU.Vendor: '+FTCPU.Vendor);   memo1.lines.Add('FTCPU.ProcessorID.text: '+FTCPU.ProcessorID.text);   memo1.lines.Add('FTCPU.Level: '+inttostr( FTCPU.Level));   memo1.lines.Add('FTCPU.Revision: '+inttostr( FTCPU.Revision));   memo1.lines.Add('FTCPU.Model: '+inttostr( FTCPU.Model));   memo1.lines.Add('FTCPU.TypeID: '+inttostr( FTCPU.TypeID));   memo1.lines.Add('FTCPU.OEMid: '+inttostr( FTCPU.OEMid));   memo1.lines.Add('FTCPU.Architecture: '+inttostr( FTCPU.Architecture));   memo1.lines.Add('FTCPU.Family: '+inttostr( FTCPU.Family));   memo1.lines.Add('FTCPU.Stepping: '+inttostr( FTCPU.Stepping));  memo1.Lines.Add('========================================');  FTDisk:=TDisk.Create;  FTDisk.RefreshInfo;  memo1.lines.Add('FTDisk.Drive: '+FTDisk.Drive);  memo1.lines.Add('FTDisk.SerialNumberLabel: '+FTDisk.SerialNumberLabel);  memo1.lines.Add('FTDisk.VolumeLabel: '+FTDisk.VolumeLabel);  memo1.lines.Add('FTDisk.FileSystem: '+FTDisk.FileSystem);  memo1.lines.Add('FTDisk.VolumeLabel: '+FTDisk.VolumeLabel);  memo1.lines.Add('FTDisk.SectorsPerCluster: '+FTDisk.SectorsPerCluster);  memo1.lines.Add('FTDisk.BytesPerSector: '+FTDisk.BytesPerSector);  memo1.lines.Add('FTDisk.FreeCluster: '+FTDisk.FreeCluster);  memo1.lines.Add('FTDisk.TotalCluster: '+FTDisk.TotalCluster);  memo1.lines.Add('FTDisk.FreeBytes: '+FTDisk.FreeBytes);  memo1.lines.Add('FTDisk.SerialNumber: '+inttostr( FTDisk.SerialNumber)); end; end. 2005-8-12 12:58:53  formobject Form1: TForm1  Left = 192  Top = 107  Width = 696  Height = 480  Caption = 'Form1'  Color = clBtnFace  Font.Charset = DEFAULT_CHARSET  Font.Color = clWindowText  Font.Height = -11  Font.Name = 'MS Sans Serif'  Font.Style = []  OldCreateOrder = False  PixelsPerInch = 96  TextHeight = 13  object Memo1: TMemo   Left = 16   Top = 16   Width = 409   Height = 417   Lines.Strings = (    'Memo1')   ScrollBars = ssBoth   TabOrder = 0  end  object Button1: TButton   Left = 528   Top = 160   Width = 75   Height = 25   Caption = 'Button1'   TabOrder = 1   OnClick = Button1Click  end end  2005-10-29 17:36:40    

上一篇:陈子昂的专栏
下一篇:如何将图片存储到数据库中

相关文章

相关评论