Unit Unit1;

Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, WinTypes, Registry, ComCtrls;

Type
  OSVERSIONINFOEX = 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;

  TOSVersionInfoEx = OSVERSIONINFOEX;
  POSVersionInfoEx = ^TOSVersionInfoEx;

  TForm1=Class(TForm)
    Label9: TLabel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    StatusBar1: TStatusBar;
    Procedure FormCreate(Sender: TObject);
    Procedure GetWindowsVersion(Var MajorVersion, MinorVersion, BuildNumber, PlatformId : Integer; Var CSDVersion : String);
    Procedure GetProductType(Var IsServer: Boolean; Var ProductTypeString, SuiteMaskString, ServicePackString : String);
    Procedure GetWindowsInfo(Var WindowsVersion, WindowsPlatformId : Integer; Var WindowsVersionString, WindowsBuildString : String);
    Function GetWindowsLongInfo : String;
  End;

Const
  wvWin311                           = 0;
  wvWin95                            = 1;
  wvWin95OSR2                        = 2;
  wvWin98                            = 3;
  wvWin98SE                          = 4;
  wvWinMe                            = 5;
  wvWinNT                            = 6;
  wvWinNTServer                      = 7;
  wvWin2K                            = 8;
  wvWin2KServer                      = 9;
  wvWinXP                            = 10;
  wvWinXPServer                      = 11;
  VER_NT_WORKSTATION                 = $0000001;
  VER_NT_DOMAIN_CONTROLLER           = $0000002;
  VER_NT_SERVER                      = $0000003;
  VER_SERVER_NT                      = $80000000;
  VER_WORKSTATION_NT                 = $40000000;
  VER_SUITE_SMALLBUSINESS            = $00000001;
  VER_SUITE_ENTERPRISE               = $00000002;
  VER_SUITE_BACKOFFICE               = $00000004;
  VER_SUITE_COMMUNICATIONS           = $00000008;
  VER_SUITE_TERMINAL                 = $00000010;
  VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020;
  VER_SUITE_EMBEDDEDNT               = $00000040;
  VER_SUITE_DATACENTER               = $00000080;
  VER_SUITE_SINGLEUSERTS             = $00000100;
  VER_SUITE_PERSONAL                 = $00000200;
  VER_SUITE_BLADE                    = $00000400;

Var
  Form1 : TForm1;

Implementation

{$R *.DFM}

Procedure TForm1.GetWindowsVersion(Var MajorVersion, MinorVersion, BuildNumber, PlatformId : Integer; Var CSDVersion : String);
Var
  VerInfoRec : OSVERSIONINFO;
Begin
  ZeroMemory(@VerInfoRec, SizeOf(OSVERSIONINFO));
  VerInfoRec.dwOSVersionInfoSize := SizeOf(OSVERSIONINFO);
  If GetVersionEx(VerInfoRec) Then Begin
                                     MajorVersion := VerInfoRec.dwMajorVersion;
                                     MinorVersion := VerInfoRec.dwMinorVersion;
                                     BuildNumber  := (VerInfoRec.dwBuildNumber and $FFFF);
                                     PlatformId   := VerInfoRec.dwPlatformId;
                                     CSDVersion   := StrPas(VerInfoRec.szCSDVersion);
                                     If (PlatformId=VER_PLATFORM_WIN32_WINDOWS)
                                       Then MinorVersion:=(VerInfoRec.dwBuildNumber And $FF0000) Shr 16;
                                   End
                              Else Begin
                                     MajorVersion := 0;
                                     MinorVersion := 0;
                                     BuildNumber  := 0;
                                     PlatformId   := VER_PLATFORM_WIN32_NT;
                                     CSDVersion   := 'Error retriving version';
                                   End;
End;

Procedure TForm1.GetProductType(Var IsServer: Boolean; Var ProductTypeString, SuiteMaskString, ServicePackString : String);
Var
  VerInfoRec    : TOSVersionInfoEx;
  pVerInfoRec   : POSVersionInfo;
  szProductType : String;
  szSuiteMask   : String;
  szCSDVersion  : String;
  IsProductType : Boolean;
  IsSuiteMask   : Boolean;
Begin
  IsServer          := False;
  ProductTypeString := '';
  SuiteMaskString   := '';
  ServicePackString := '';
  ZeroMemory(@VerInfoRec, SizeOf(OSVERSIONINFO));
  VerInfoRec.dwOSVersionInfoSize := SizeOf(VerInfoRec);
  pVerInfoRec := @VerInfoRec;
  If GetVersionEx(pVerInfoRec^)
    Then Begin
           IsProductType := True;
           szProductType := '';
           Case VerInfoRec.wProductType Of
             VER_NT_WORKSTATION       : szProductType:='Professional';
             VER_NT_DOMAIN_CONTROLLER : szProductType:='Domain controller';
             VER_NT_SERVER            : szProductType:='Server'
             Else IsProductType:=False;
                  IsServer:=True;
           End;
           IsSuiteMask:=False;
           szSuiteMask:='';
           If VerInfoRec.wProductType=VER_NT_WORKSTATION
             Then Begin
                    IsServer:=False;
                    If (VerInfoRec.wSuiteMask And VER_SUITE_SINGLEUSERTS)<>0
                      Then szSuiteMask:='Personal';
                    If (VerInfoRec.wSuiteMask And VER_SUITE_PERSONAL)<>0
                      Then szSuiteMask:=szSuiteMask+'Home Edition';
                  End
             Else Begin
                    IsServer:=True;
                    If (VerInfoRec.wSuiteMask And VER_SUITE_SMALLBUSINESS)<>0
                      Then szSuiteMask:=szSuiteMask+'Small Business Server';
                    If (VerInfoRec.wSuiteMask And VER_SUITE_ENTERPRISE)<>0
                      Then Begin
                             If VerInfoRec.dwMinorVersion=0
                               Then szSuiteMask:=szSuiteMask+'Advanced Server'
                               Else szSuiteMask:=szSuiteMask+'Enterprise Server';
                           End;
                    If (VerInfoRec.wSuiteMask And VER_SUITE_BACKOFFICE)<>0
                      Then szSuiteMask:=szSuiteMask+'BackOffice components';
                    If (VerInfoRec.wSuiteMask And VER_SUITE_COMMUNICATIONS)<>0
                      Then szSuiteMask:=szSuiteMask+'Communication components';
                    If (VerInfoRec.wSuiteMask And VER_SUITE_TERMINAL)<>0
                      Then szSuiteMask:=szSuiteMask+'Terminal Services';
                    If (VerInfoRec.wSuiteMask And VER_SUITE_SMALLBUSINESS_RESTRICTED)<>0
                      Then szSuiteMask:=szSuiteMask+'Small Business Server with restrictive client license';
                    If (VerInfoRec.wSuiteMask And VER_SUITE_EMBEDDEDNT)<>0
                      Then szSuiteMask:=szSuiteMask+'Embedded NT';
                    If (VerInfoRec.wSuiteMask And VER_SUITE_DATACENTER)<>0
                      Then szSuiteMask:=szSuiteMask+'DataCenter Server';
                    If (VerInfoRec.wSuiteMask And VER_SUITE_BLADE)<>0
                      Then szSuiteMask:=szSuiteMask+'Web Server';
                  End;
           If szSuiteMask<>''
             Then IsSuiteMask:=True;
           If IsProductType Or IsSuiteMask
             Then Begin
                    If IsProductType And IsSuiteMask
                      Then Begin
                             ProductTypeString:=szProductType;
                             SuiteMaskString:=szSuiteMask;
                           End
                      Else Begin
                             If IsProductType
                               Then ProductTypeString:=szProductType
                               Else SuiteMaskString:=szSuiteMask;
                           End;
                  End;
           ServicePackString:=StrPas(VerInfoRec.szCSDVersion);
         End
    Else Begin
           With TRegistry.Create Do
             Begin
               Try
                 RootKey:=HKEY_LOCAL_MACHINE;
                 If OpenKey('SYSTEM\CurrentControlSet\Control\ProductOptions',True)
                   Then Begin
                          If ValueExists('ProductType')
                            Then Begin
                                   szProductType:=ReadString('ProductType');
                                   If Pos('WINNT',UpperCase(szProductType))<>0
                                     Then Begin
                                            IsServer:=False;
                                            ProductTypeString:='Professional';
                                          End
                                     Else Begin
                                            IsServer:=True;
                                            If (Pos('SERVERNT',UpperCase(szProductType))<>0)
                                              Then ProductTypeString:='Server';
                                            If (Pos('LANMANNT',UpperCase(szProductType))<>0)
                                              Then ProductTypeString:='Advanced Server';
                                          End;
                                 End;
                          If ValueExists('SuiteMask')
                            Then Begin
                                   szSuiteMask:=ReadString('SuiteMask');
                                   IsServer:=True;
                                   SuiteMaskString:=szSuiteMask;
                                 End;
                        End;
                 CloseKey;
                 If OpenKey('SYSTEM\CurrentControlSet\Control\Windows',True)
                   Then Begin
                          If ValueExists('CSDVersion')
                            Then Begin
                                   szCSDVersion:=ReadString('CSDVersion');
                                   ServicePackString:=szCSDVersion;
                                 End;
                        End;
                 CloseKey;
               Finally
                 Free;
               End;
             End;
         End;
End;

Procedure TForm1.GetWindowsInfo(Var WindowsVersion, WindowsPlatformId : Integer; Var WindowsVersionString, WindowsBuildString : String);
Var
  MajorVersion      : Integer;
  MinorVersion      : Integer;
  BuildNumber       : Integer;
  PlatformId        : Integer;
  CSDVersion        : String;
  IsServer          : Boolean;
  ProductTypeString : String;
  SuiteMaskString   : String;
  ServicePackString : String;
Begin
  GetWindowsVersion(MajorVersion,MinorVersion,BuildNumber,PlatformId,CSDVersion);
  WindowsVersion:=wvWinXP;
  WindowsPlatformId:=VER_PLATFORM_WIN32_NT;
  Case PlatformId Of
    VER_PLATFORM_WIN32s        : Begin
                                   WindowsPlatformId:=VER_PLATFORM_WIN32s;
                                   WindowsVersion:=wvWin311;
                                 End;
    VER_PLATFORM_WIN32_WINDOWS : Begin
                                   WindowsPlatformId:=VER_PLATFORM_WIN32_WINDOWS;
                                   If (MajorVersion=4)
                                     Then Begin
                                            Case MinorVersion Of
                                              00..09 : Begin
                                                         If Pos('C',CSDVersion) In [1,2]
                                                           Then WindowsVersion:=wvWin95OSR2
                                                           Else WindowsVersion:=wvWin95;
                                                       End;
                                              10..89 : Begin
                                                         If Pos('A',CSDVersion) In [1,2]
                                                           Then WindowsVersion:=wvWin98SE
                                                           Else WindowsVersion:=wvWin98;
                                                       End;
                                              90..99 : WindowsVersion:=wvWinMe;
                                            End;
                                          End;
                                 End;
    VER_PLATFORM_WIN32_NT      : Begin
                                   WindowsPlatformId:=VER_PLATFORM_WIN32_NT;
                                   GetProductType(IsServer,ProductTypeString,SuiteMaskString,ServicePackString);
                                   If (MajorVersion=5)
                                     Then Begin
                                            If IsServer
                                              Then Begin
                                                     Case MinorVersion Of
                                                       0 : WindowsVersion:=wvWin2kServer;
                                                       1 : WindowsVersion:=wvWinXPServer;
                                                     End;
                                                   End
                                              Else begin
                                                     Case MinorVersion Of
                                                       0 : WindowsVersion:=wvWin2k;
                                                       1 : WindowsVersion:=wvWinXP;
                                                     End;
                                                   End;
                                          End
                                     Else Begin
                                            If (MajorVersion<=4)
                                              Then Begin
                                                     If IsServer
                                                       Then WindowsVersion:=wvWinNTServer
                                                       Else WindowsVersion:=wvWinNT;
                                                   End;
                                          End;
                                 End;
  End;
  WindowsVersionString:='Microsoft Windows ';
  Case WindowsVersion Of
    wvWin311      : WindowsVersionString:=WindowsVersionString+'3.11';
    wvWin95       : WindowsVersionString:=WindowsVersionString+'95';
    wvWin95OSR2   : WindowsVersionString:=WindowsVersionString+'95 OSR2';
    wvWin98       : WindowsVersionString:=WindowsVersionString+'98';
    wvWin98SE     : WindowsVersionString:=WindowsVersionString+'98 SE';
    wvWinMe       : WindowsVersionString:=WindowsVersionString+'Me';
    wvWinNT       : WindowsVersionString:=WindowsVersionString+'NT';
    wvWinNTServer : WindowsVersionString:=WindowsVersionString+'NT Server';
    wvWin2K       : WindowsVersionString:=WindowsVersionString+'2000';
    wvWin2KServer : WindowsVersionString:=WindowsVersionString+'2000 Server';
    wvWinXP       : WindowsVersionString:=WindowsVersionString+'XP';
    wvWinXPServer : WindowsVersionString:=WindowsVersionString+'.NET Server';
  End;
  WindowsBuildString:=IntToStr(MajorVersion)+'.'+Format('%2.2d',[MinorVersion])+'.'+IntToStr(BuildNumber);
End;

Function TForm1.GetWindowsLongInfo : String;
Var
  WindowsVersion       : Integer;
  WindowsPlatformId    : Integer;
  WindowsVersionString : String;
  WindowsBuildString   : String;
  IsServer             : Boolean;
  ProductTypeString    : String;
  SuiteMaskString      : String;
  ServicePackString    : String;
Begin
  GetWindowsInfo(WindowsVersion,WindowsPlatformId,WindowsVersionString,WindowsBuildString);
  Result:=WindowsVersionString+' '+WindowsBuildString;
  GetProductType(IsServer,ProductTypeString,SuiteMaskString,ServicePackString);
  If ServicePackString <> '' Then Result:=Result+' '+ServicePackString;
  If ProductTypeString <> '' Then Result:=Result+' '+ProductTypeString;
  If SuiteMaskString   <> '' Then Result:=Result+' '+SuiteMaskString;
End;

Procedure TForm1.FormCreate(Sender: TObject);
Var
  WindowsVersion       : Integer;
  WindowsPlatformId    : Integer;
  WindowsVersionString : String;
  WindowsBuildString   : String;
  IsServer             : Boolean;
  ProductTypeString    : String;
  SuiteMaskString      : String;
  ServicePackString    : String;
Begin
  GetWindowsInfo(WindowsVersion,WindowsPlatformId,WindowsVersionString,WindowsBuildString);
  Case WindowsVersion Of
    wvWin311      : Label2.Caption := 'Windows Version = Win311';
    wvWin95       : Label2.Caption := 'Windows Version = Win95';
    wvWin95OSR2   : Label2.Caption := 'Windows Version = Win95OSR2';
    wvWin98       : Label2.Caption := 'Windows Version = Win98';
    wvWin98SE     : Label2.Caption := 'Windows Version = Win98SE';
    wvWinMe       : Label2.Caption := 'Windows Version = WinMe';
    wvWinNT       : Label2.Caption := 'Windows Version = WinNT';
    wvWinNTServer : Label2.Caption := 'Windows Version = WinNTServer';
    wvWin2K       : Label2.Caption := 'Windows Version = Win2K';
    wvWin2KServer : Label2.Caption := 'Windows Version = Win2KServer';
    wvWinXP       : Label2.Caption := 'Windows Version = WinXP';
    wvWinXPServer : Label2.Caption := 'Windows Version = WinXPServer';
  End;
  Case WindowsPlatformId Of
    VER_PLATFORM_WIN32s        : Label3.Caption := 'Windows Platform Id = WIN32s';
    VER_PLATFORM_WIN32_WINDOWS : Label3.Caption := 'Windows Platform Id = WIN32_WINDOWS';
    VER_PLATFORM_WIN32_NT      : Label3.Caption := 'Windows Platform Id = WIN32_NT';
  End;
  Label4.Caption := 'Windows Version String = '+WindowsVersionString;
  Label5.Caption := 'Windows Build String = '+WindowsBuildString;
  Label7.Caption := '';
  Label8.Caption := '';
  Label6.Caption := '';
  If WindowsPlatformId = VER_PLATFORM_WIN32_NT Then
    Begin
      GetProductType(IsServer,ProductTypeString,SuiteMaskString,ServicePackString);
      Label6.Caption := 'Service Pack String = '+ServicePackString;
      Label7.Caption := 'Product Type String = '+ProductTypeString;
      Label8.Caption := 'Suite Mask String = '+SuiteMaskString;
    End;
  Label1.Caption := GetWindowsLongInfo;
End;

End.