获取操作系统，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: 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 asthis header and } { copyrightinformation 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 aparticular 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; destructorDestroy;override; procedure RefreshInfo; published property Numlock : BooleanRead FNumlockWrite FNumlock; property ScrollLock: BooleanRead FScrollLockWrite FScrollLock; property Capslock: BooleanRead FCapslockWrite 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 FDACTypeWrite FDACType; property Revision: String Read FRevision Write FRevision; property AGP : BooleanRead FAGPWrite FAGP; property Processor3D : BooleanRead F3dProcessorWrite 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 : stringread FStandardName write FStandardName; property StandardTime : TDateTimeread FStandardTime write FStandardTime; property DaylightName : Stringread FDaylightName write FDaylightName; property DaylightTime : TDateTimeread FDaylightTime write FDaylightTime; property DayLightBias : Integerread 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; procedureRefreshInfo; 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 FBytesPerSectorwrite FBytesPerSector; property FreeCluster : String read FNumberOfFreeCluster write FNumberOfFreeCluster ; property TotalCluster: String read FTotalNumberOfClusterwrite FTotalNumberOfCluster; property TotalBytes: String read FTotalNumberOfByteswrite FTotalNumberOfBytes; // property NumberOfFreeBytes : String read FTotalNumberOfFreeByteswrite 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 ReadFProcessorTypeWrite FProcessorType; Property Version : String ReadFProcessorVersionWrite FProcessorVersion; property Freq: String ReadFFreq 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; destructorDestroy; 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 : TAPMRead 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} PUSHEAX{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 PUSHEBX {Save affected register} PUSHEDI 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 PUSHEBX{Save affected register} PUSHEDI MOV EDI,EAX{@Result (TVendor)} MOV EAX,0 DW$A20F{CPUID Command} MOV EAX,EBX XCHGEBX,ECX {save ECX result} MOVECX,4 @1: STOSB SHR EAX,8 LOOP@1 MOV EAX,EDX MOVECX,4 @2: STOSB SHR EAX,8 LOOP@2 MOV EAX,EBX MOVECX,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; varKeys: 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:=tString |