):<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Registry, StdCtrls;
type
_OSVERSIONINFOEX = 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;
TOSVERSIONINFOEX = _OSVERSIONINFOEX;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;
function GetVersionExA(var lpVersionInformation: TOSVersionInfoEX): BOOL; stdcall;
external kernel32;
const
VER_NT_WORKSTATION :Integer = 1;
VER_SUITE_ENTERPRISE :Integer = 2;
VER_NT_SERVER :Integer = 3;
VER_SUITE_DATACENTER :Integer = 128;
VER_SUITE_PERSONAL :Integer = 512;
var
Form1: TForm1;
implementation
{$R *.dfm}
function OSInfo:String;
var
NTBres, BRes: Boolean;
OSVI: TOSVERSIONINFO;
OSVI_NT: TOSVERSIONINFOEX;
TmpStr: String;
begin
Result := 'Error';
NTBRes := False;
try
OSVI_NT.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFOEX);
NTBRes := GetVersionExA(OSVI_NT);
OSVI.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
BRes := GetVersionEx(OSVI);
except
OSVI.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
BRes := GetVersionEx(OSVI);
end;
if (not BRes) and (not NTBres) then Exit;
Move(OSVI, OSVI_NT, SizeOf(TOSVersionInfo));
case OSVI_NT.dwPlatformId of
VER_PLATFORM_WIN32_NT:
begin
if OSVI_NT.dwMajorVersion <= 4 then Result := 'Windows NT ';
if (OSVI_NT.dwMajorVersion = 5) and
(OSVI_NT.dwMinorVersion = 0) then Result := 'Windows 2000 ';
if (OSVI_NT.dwMajorVersion = 5) and
(OSVI_NT.dwMinorVersion = 1) then Result := 'Windows XP ';
if (OSVI_NT.dwMajorVersion = 6) and
(OSVI_NT.dwMinorVersion = 0) then Result := 'Windows Vista';
if NTBres then
begin
if OSVI_NT.wProductType = VER_NT_WORKSTATION then
begin
if OSVI_NT.wProductType = VER_NT_WORKSTATION then
begin
case OSVI_NT.wSuiteMask of
512: Result := Result + 'Personal';
768: Result:= Result+'Home Premium';
else
Result := Result + 'Professional';
end;
end
else
if OSVI_NT.wProductType = VER_NT_SERVER then
begin
if OSVI_NT.wSuiteMask = VER_SUITE_DATACENTER then
Result := Result + 'DataCenter Server'
else
if OSVI_NT.wSuiteMask = VER_SUITE_ENTERPRISE then
Result := Result + 'Advanced Server'
else
Result := Result + 'Server';
end;
end
else
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKeyReadOnly('SYSTEM\CurrentControlSet\Control\ProductOptions') then
try
TmpStr := UpperCase(ReadString('ProductType'));
if TmpStr = 'WINNT' then
Result := Result + 'Workstation';
if TmpStr = 'SERVERNT' then
Result := Result + 'Server';
finally
CloseKey;
end;
finally
Free;
end;
end;
end;
VER_PLATFORM_WIN32_WINDOWS :
begin
if (OSVI.dwMajorVersion = 4) and (OSVI.dwMinorVersion = 0) then
begin
Result := 'Windows 95 ';
if OSVI.szCSDVersion[1] = 'C' then
Result := Result + 'OSR2';
end;
if (OSVI.dwMajorVersion = 4) and (OSVI.dwMinorVersion = 10) then
begin
Result := 'Windows 98 ';
if OSVI.szCSDVersion[1] = 'A' then
Result := Result + 'SE';
end;
if (OSVI.dwMajorVersion = 4) and (OSVI.dwMinorVersion = 90) then
Result := 'Windows Me';
end;
VER_PLATFORM_WIN32s:
Result := 'Microsoft Win32s';
else
Result := 'Unknown';
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(OSInfo);
end;
end.