📄 systeminfo.pas
字号:
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 ⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -