var
Form1: TForm1;
{$IFDEF CONDITIONALEXPRESSIONS}
{$IF Defined(TOSVersionInfoEx)}
{$DEFINE TOSVERSIONINFOEX_DEFINED}
{$IFEND}
{$ENDIF}
{$IFNDEF TOSVERSIONINFOEX_DEFINED}
type
POSVersionInfoEx = ^TOSVersionInfoEx;
TOSVersionInfoEx = packed record
dwOSVersionInfoSize: DWORD;
dwMajorVersion : DWORD;
dwMinorVersion : DWORD;
dwBuildNumber : DWORD;
dwPlatformId : DWORD;
szCSDVersion : array [0..127] of AnsiChar;
wServicePackMajor : Word;
wServicePackMinor : Word;
wSuiteMask : Word;
wProductType : Byte;
wReserved : Byte;
end;
const
VER_SERVER_NT = $80000000;
{$EXTERNALSYM VER_SERVER_NT}
VER_WORKSTATION_NT = $40000000;
{$EXTERNALSYM VER_WORKSTATION_NT}
VER_SUITE_SMALLBUSINESS = $00000001;
{$EXTERNALSYM VER_SUITE_SMALLBUSINESS}
VER_SUITE_ENTERPRISE = $00000002;
{$EXTERNALSYM VER_SUITE_ENTERPRISE}
VER_SUITE_BACKOFFICE = $00000004;
{$EXTERNALSYM VER_SUITE_BACKOFFICE}
VER_SUITE_COMMUNICATIONS = $00000008;
{$EXTERNALSYM VER_SUITE_COMMUNICATIONS}
VER_SUITE_TERMINAL = $00000010;
{$EXTERNALSYM VER_SUITE_TERMINAL}
VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020;
{$EXTERNALSYM VER_SUITE_SMALLBUSINESS_RESTRICTED}
VER_SUITE_EMBEDDEDNT = $00000040;
{$EXTERNALSYM VER_SUITE_EMBEDDEDNT}
VER_SUITE_DATACENTER = $00000080;
{$EXTERNALSYM VER_SUITE_DATACENTER}
VER_SUITE_SINGLEUSERTS = $00000100;
{$EXTERNALSYM VER_SUITE_SINGLEUSERTS}
VER_SUITE_PERSONAL = $00000200;
{$EXTERNALSYM VER_SUITE_PERSONAL}
VER_SUITE_BLADE = $00000400;
{$EXTERNALSYM VER_SUITE_BLADE}
VER_SUITE_EMBEDDED_RESTRICTED = $00000800;
{$EXTERNALSYM VER_SUITE_EMBEDDED_RESTRICTED}
VER_SUITE_SECURITY_APPLIANCE = $00001000;
{$EXTERNALSYM VER_SUITE_SECURITY_APPLIANCE}
const
VER_NT_WORKSTATION = $0000001;
{$EXTERNALSYM VER_NT_WORKSTATION}
VER_NT_DOMAIN_CONTROLLER = $0000002;
{$EXTERNALSYM VER_NT_DOMAIN_CONTROLLER}
VER_NT_SERVER = $0000003;
{$EXTERNALSYM VER_NT_SERVER}
{$ENDIF}
//
function GetOSVersionInfo(var Info: TOSVersionInfoEx): Boolean;
begin
FillChar(Info, SizeOf(TOSVersionInfoEx), 0);
Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);
Result := GetVersionEx(TOSVersionInfo(Addr(Info)^));
if (not Result) then
begin
FillChar(Info, SizeOf(TOSVersionInfoEx), 0);
Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);
Result := GetVersionEx(TOSVersionInfo(Addr(Info)^));
if (not Result) then
Info.dwOSVersionInfoSize := 0;
end;
end;
function GetOSVersionText: string;
var
Info: TOSVersionInfoEx;
Key: HKEY;
begin
Result := '';
if (not GetOSVersionInfo(Info)) then
Exit;
case Info.dwPlatformId of
VER_PLATFORM_WIN32s:
Result := 'Microsoft Win32s';
VER_PLATFORM_WIN32_WINDOWS:
if (Info.dwMajorVersion = 4) and (Info.dwMinorVersion = 0) then
begin
Result := 'Microsoft Windows 95';
if (Info.szCSDVersion[1] in ['B', 'C']) then
Result := Result +' OSR2';
end
else if (Info.dwMajorVersion = 4) and (Info.dwMinorVersion = 10) then
begin
Result := 'Microsoft Windows 98';
if (Info.szCSDVersion[1] = 'A') then
Result := Result + ' SE';
end
else if (Info.dwMajorVersion = 4) and (Info.dwMinorVersion = 90) then
Result := 'Microsoft Windows Millennium Edition';
VER_PLATFORM_WIN32_NT:
begin
if (Info.dwMajorVersion = 5) and (Info.dwMinorVersion = 2) then
Result := 'Microsoft Windows Server 2003'
else if (Info.dwMajorVersion = 5) and (Info.dwMinorVersion = 1) then
Result := 'Microsoft Windows XP'
else if (Info.dwMajorVersion = 5) and (Info.dwMinorVersion = 0) then
Result := 'Microsoft Windows 2000'
else
Result := 'Microsoft Windows NT';
if (Info.dwOSVersionInfoSize >= SizeOf(TOSVersionInfoEx)) then
begin
if (Info.wProductType = VER_NT_WORKSTATION) then
begin
if (Info.dwMajorVersion = 4) then
Result := Result + #10'Workstation 4.0'
else if(Info.wSuiteMask and VER_SUITE_PERSONAL <> 0) then
Result := Result + #10'Home Edition'
else
Result := Result + #10'Professional' + #13#10;
end
else if (Info.wProductType = VER_NT_SERVER) then
begin
if (Info.dwMajorVersion = 5) and (Info.dwMinorVersion = 2) then
begin
if (Info.wSuiteMask and VER_SUITE_DATACENTER <> 0) then
Result := Result + #10'Datacenter Edition'
else if (Info.wSuiteMask and VER_SUITE_ENTERPRISE <> 0) then
Result := Result + #10'Enterprise Edition'
else if (Info.wSuiteMask = VER_SUITE_BLADE) then
Result := Result + #10'Web Edition'
else
Result := Result + #10'Standard Edition';
end
else if (Info.dwMajorVersion = 5) and (Info.dwMinorVersion = 0) then
begin
if (Info.wSuiteMask and VER_SUITE_DATACENTER <> 0) then
Result := Result + #10'Datacenter Server'
else if (Info.wSuiteMask and VER_SUITE_ENTERPRISE <> 0) then
Result := Result + #10'Advanced Server'
else
Result := Result + #10'Server';
end
else
begin
Result := Result + #10'Server ' +
IntToStr(Info.dwMajorVersion) + '.' +
IntToStr(Info.dwMinorVersion);
if (Info.wSuiteMask and VER_SUITE_ENTERPRISE <> 0) then
Result := Result + ', Enterprise Edition';
end;
end;
end;
if (Info.dwMajorVersion = 4) and
(StrIComp(Info.szCSDVersion, 'Service Pack 6') = 0) and
(RegOpenKeyEx(HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Hotfix\Q246009', 0,
KEY_QUERY_VALUE, Key) = ERROR_SUCCESS) then
begin
Result := Result + #10'Service Pack 6a';
RegCloseKey(Key);
end
else
Result := Result + #10 + StrPas(Info.szCSDVersion);
Result := Result + #10'(Build ' +
IntToStr(Info.dwBuildNumber and $FFFF) + ')';
end;
end;
end;
Beispiel :
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Text := GetOSVersionText;
end;
Keine Kommentare:
Kommentar veröffentlichen