📄 computerinfo.pas
字号:
Result.MinorVersion := dwMinorVersion;
end;
Result.WindowVersion := GetVersion;
Result.WindowName := GetVersionName(GetVersion);
Result.CurrentUserName := GetUserName;
Result.Language := GetSystemDefaultLangName;
Result.Folders := GetSystemFolders;
end;
var
OS : Integer = 0;
function GetVersion : Integer;
var
VerInfo: TOSVersionInfo;
begin
if OS = 0 then
begin
VerInfo.dwOSVersionInfoSize := SizeOf (TOSVersionInfo);
GetVersionEx (VerInfo);
case VerInfo.dwPlatformId of
VER_PLATFORM_WIN32_NT :
begin
case VerInfo.dwMajorVersion of
0..3 : OS := OS_WINDOWSNT3;
4 :
If string(VerInfo.szCSDVersion)='Service Pack 4' then
OS := OS_WINDOWSNT4SP4
else OS := OS_WINDOWSNT4;
else
if VerInfo.dwMajorVersion >= 5 then
if VerInfo.dwMinorVersion > 0 then
OS := OS_WINDOWSXP
else OS := OS_WINDOWS2000;
end;
end;
VER_PLATFORM_WIN32_WINDOWS :
begin
If (VerInfo.dwMajorVersion=4) and (VerInfo.dwMinorVersion=0) then
begin
If VerInfo.dwBuildNumber>1000 then
OS := OS_WINDOWS95OSR2
else OS := OS_WINDOWS95;
end
else if (VerInfo.dwMajorVersion=4) and (VerInfo.dwMinorVersion=10) then
begin
If (VerInfo.szCSDVersion[1] = 'A') then
OS := OS_WINDOWS98SE
else OS := OS_WINDOWS98;
end
else if (VerInfo.dwMajorVersion = 4) and (VerInfo.dwMinorVersion = 90) Then
OS := OS_WINDOWSME
else OS := OS_UNKNOW;
end;
VER_PLATFORM_WIN32s : OS := OS_WINDOWS31;
else OS := OS_UNKNOW;
end;
end;
result := OS;
end;
function GetVersionName(Version : Integer): string;
begin
case Version of
OS_UNKNOW : Result := 'Microsoft Windows';
OS_WINDOWS31 : Result := 'Microsoft Windows 3.1';
OS_WINDOWS95 : Result := 'Microsoft Windows 95';
OS_WINDOWS95OSR2 : Result := 'Microsoft Windows 95 OSR2';
OS_WINDOWS98 : Result := 'Microsoft Windows 98';
OS_WINDOWS98SE : Result := 'Microsoft Windows 98 Second Edition';
OS_WINDOWSME : Result := 'Microsoft Windows Millennium Edition';
OS_WINDOWSNT3 : Result := 'Microsoft Windows NT 3';
OS_WINDOWSNT4 : Result := 'Microsoft Windows NT 4';
OS_WINDOWSNT4SP4 : Result := 'Microsoft Windows NT 4 + SP4';
OS_WINDOWS2000 : Result := 'Microsoft Windows 2000 / NT 5';
OS_WINDOWSXP : Result := 'Microsoft Windows XP';
end;
end;
function GetUserName : string;
const
cnMaxUserNameLen = 254;
var
dwUserNameLen : DWord;
begin
result := '';
dwUserNameLen := cnMaxUserNameLen-1;
SetLength( Result, cnMaxUserNameLen );
Windows.GetUserName( PChar( Result ), dwUserNameLen );
SetLength( result, dwUserNameLen );
end;
function GetSystemDefaultLangName : string;
var
IdiomaID:LangID;
Idioma: array [0..100] of char;
begin
IdiomaID:= GetSystemDefaultLangID;
VerLanguageName(IdiomaID,Idioma,100);
Result:=String(Idioma);
end;
function GetTimeZoneinfo : TTimeZoneInfo;
const
KeyNt = '\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones';
Key9x = '\SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones';
var
Tzi: TTimeZoneInformation;
S : TStrings;
I : Integer;
Key : string;
begin
GetTimeZoneInformation(Tzi);
with Tzi do
begin
Result.Bias := Bias;
Result.StandardName := WideCharToString(StandardName);
Result.DayLightName := WideCharToString(DayLightName);
StandardDate.wYear := 2000;
//day = 5 => last Sunday in wMonth, otherwise wDay = Sunday in wMonth for change!
Result.StandardDate := SystemTimeToDateTime(StandardDate);
DayLightDate.wYear := 2000;
//day = 5 => last Sunday in wMonth, otherwise wDay = Sunday in wMonth for change!
Result.DayLightDate := SystemTimeToDateTime(DayLightDate);
Result.StandardBias := StandardBias;
Result.DayLightBias := DayLightBias;
end;
S := TStringList.Create;
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
If Win32PlatForm = VER_PLATFORM_WIN32_NT then
Key := KeyNt
else Key := Key9x;
If OpenKey(Key, False) Then
begin
GetKeyNames(S);
SetLength(Result.Standards, S.Count);
for I := 0 to S.Count-1 do
If OpenKey(Key+'\'+S[I], False) Then
begin
Result.Standards[I].Display := ReadString('Display');
Result.Standards[I].Dlt := ReadString('dlt');
Result.Standards[I].Index := ReadInteger('Index');
Result.Standards[I].MapID := Readstring('MapID');
Result.Standards[I].Std := ReadString('Std');
CloseKey;
end;
CloseKey;
end;
finally
S.Free;
Free;
end;
end;
function GetScreenSaverInfo: TScreenSaverInfo;
const
sz = 1023;
var
Time : Integer;
Bool : Boolean;
Path : array[0..sz] of char;
procedure Enumeration(var List: TStrings);
var
R : TSearchRec;
S : string;
T : Integer;
begin
S := Path;
If S[Length(S)] <> '\' then S := S + '\';
T := FindFirst(s + '*.scr', faAnyFile + faArchive + faSysFile + faHidden, R);
while T = 0 do
begin
List.Add(S + R.Name);
T := FindNext(R);
end;
SysUtils.FindClose(R);
end;
begin
SystemParametersInfo(SPI_GETSCREENSAVETIMEOUT, 0, @time, 0);
Result.Delay := time;
SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0, @bool, 0);
Result.Active := bool;
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @bool, 0);
Result.Running := bool;
with TRegistry.Create do
begin
RootKey := HKEY_CURRENT_USER;
If OpenKey('\Control Panel\Desktop', False) then
begin
Result.Secure := ReadString('ScreenSaverSecure') = '';
Result.ScreenSaver := ReadString('SCRNSAVE.EXE');
Result.UsePassword := ReadString('ScreenSaveUsePassword') = '1';
CloseKey;
end;
Free;
end;
Result.ScreenSavers := TStringList.Create;
GetWindowsDirectory(Path, sz);
Enumeration(Result.ScreenSavers);
GetSystemDirectory(Path, sz);
Enumeration(Result.ScreenSavers);
end;
function StartScreenSaver(const ExeName, Paras : String): THandle;
var
PI : PROCESS_INFORMATION;
SIA : _STARTUPINFOA;
begin
PI.hProcess:= 0;
with SIA do
begin
cb:= SizeOf(SIA);
lpReserved:= nil;
lpDesktop:= nil;
lpTitle:= nil;
dwFlags:= STARTF_USESHOWWINDOW or STARTF_FORCEOFFFEEDBACK;
wShowWindow:= SW_SHOW;
cbReserved2:= 0;
lpReserved2:= nil;
end;
Windows.CreateProcess(PChar(exeName), PChar(paras), nil, nil, false,
NORMAL_PRIORITY_CLASS, nil, nil, SIA, PI);
CloseHandle(PI.hThread);
Result:= PI.hProcess;
end;
function GetPowerStatusInfo : TPowerStatusInfo;
var
Sps: _SYSTEM_POWER_STATUS;
begin
GetSystemPowerStatus(Sps);
with Sps do
begin
case ACLineStatus of
0: Result.ACLineStatus := lsOffline;
1: Result.ACLineStatus := lsOnline;
else Result.ACLineStatus := lsUnknown;
end;
Result.BatteryFlags:= [];
If BatteryFlag and 1 = 1 then Include(Result.BatteryFlags, bfHigh);
If BatteryFlag and 2 = 2 then Include(Result.BatteryFlags, bfLow);
If BatteryFlag and 4 = 4 then Include(Result.BatteryFlags, bfCritical);
If BatteryFlag and 8 = 8 then Include(Result.BatteryFlags, bfCharging);
If BatteryFlag and 128 = 128 then Include(Result.BatteryFlags, bfNoSystemBat);
If BatteryFlag and 256 = 256 then Include(Result.BatteryFlags, bfUnkown);
Result.BatterLifePercent := BatteryLifePercent;
Result.BatteryLifeTime:= BatteryLifeTime;
Result.BatteryFullLifeTime:= BatteryFullLifeTime;
end;
end;
function GetInternetInfo : TInternetInfo;
var
Reg : TRegistry;
procedure GetAdvOpt(aPath, aN: string; var Info : TInternetInfo);
var
S : TStrings;
I : LongInt;
J : LongInt;
CheckedValueS: string;
CheckedValueI: LongInt;
begin
S := TStringlist.Create;
with Reg do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\Microsoft\Internet Explorer\AdvancedOptions' + aPath, false);
GetKeyNames(S);
J := High(Info.InerAdvProps)+1;
SetLength(Info.InerAdvProps, S.Count+J);
for I:= 0 to S.Count - 1 do
begin
If OpenKey('\SOFTWARE\Microsoft\Internet Explorer\AdvancedOptions' + aPath + '\' + S[I], false) then
begin
If AnsiCompareText(ReadString('Type'), 'group') = 0 then
GetAdvOpt(aPath + '\' + S[I], aN + ReadString('Text') + ':', Info)
else begin
Info.InerAdvProps[I+J].Name := ReadString('Text');
case GetDataType('CheckedValue') of
rdUnknown,
rdBinary: ;
rdString,
rdExpandString: CheckedValueS := ReadString('CheckedValue');
rdInteger: CheckedValueI := ReadInteger('CheckedValue');
end;
RootKey:= HKEY_CURRENT_USER; //R.ReadInteger('HKeyRoot');
OpenKey(ReadString('RegPath'), false);
If ValueExists(ReadString('ValueName')) then
begin
case Reg.GetDataType(ReadString('ValueName')) of
rdUnknown,
rdBinary: ;
rdString,
rdExpandString:
Info.InerAdvProps[I+J].Value:= AnsiSameText(CheckedValueS, ReadString(ReadString('ValueName')));
rdInteger: Info.InerAdvProps[I+J].Value:= CheckedValueI = ReadInteger(ReadString('ValueName'));
end;
end
else Info.InerAdvProps[I+J].Value:= false;
CloseKey;
end;
end;
CloseKey;
end;
finally
S.Free;
end;
end;
procedure GetZoneSites(aZoneIndex: string; aZoneDomain: string; aURL: string; aSites: TStrings);
var
S: TStrings;
I: LongInt;
begin
S:= TStringList.Create;
try
with Reg do
begin
OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains' + aZoneDomain, false);
GetValueNames(S);
for I:= 0 to S.Count - 1 do
If (S[I] <> '') and (AnsiCompareText(IntToStr(ReadInteger(S[I])), aZoneIndex) = 0) then
aSites.Add(S[I] + '://' + aURL);
S.Clear;
GetKeyNames(S);
CloseKey;
for I:= 0 to S.Count - 1 do
GetZoneSites(aZoneIndex, aZoneDomain + '\' + S[I], S[I] + '.' + aURL, aSites);
end;
finally
S.Free;
end;
end;
var
S : TStrings;
I : LongInt;
D : PItemIDList;
P : array[0..MAX_PATH] of Char;
begin
S := TStringList.Create;
Reg := TRegistry.Create;
try
with Reg do
begin
(*-------------------------------------*)
RootKey := HKEY_CURRENT_USER;
OpenKey('\Software\Microsoft\Internet Explorer\Main\', False);
Result.HomePage := ReadString('Start Page');
CloseKey;
(*-------------------------------------*)
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\Clients\Calendar', False);
OpenKey(ReadString(''), False);
Result.Calendar := ReadString('');
CloseKey;
CloseKey;
(*-------------------------------------*)
OpenKey('\SOFTWARE\Microsoft\Internet Explorer', False);
Result.IEVersion := ReadString('Version');
CloseKey;
(*-------------------------------------*)
OpenKey('\SOFTWARE\Clients\Contacts', False);
OpenKey(ReadString(''), False);
Result.Contacts := ReadString('');
CloseKey;
CloseKey;
(*-------------------------------------*)
OpenKey('\SOFTWARE\Clients\Mail', False);
OpenKey(ReadString(''), False);
Result.EMailClient := ReadString('');
CloseKey;
C⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -