Get Windows TOS Fragment Version

Unit Windows_Fragment.pas

unit Windows_Fragment;

interface

uses
  Windows;

type
  POSVersionInfoA = ^TOSVersionInfoA;
  POSVersionInfoW = ^TOSVersionInfoW;
  POSVersionInfo = POSVersionInfoA;
  _OSVERSIONINFOA = record
    dwOSVersionInfoSize: DWORD;
    dwMajorVersion: DWORD;
    dwMinorVersion: DWORD;
    dwBuildNumber: DWORD;
    dwPlatformId: DWORD;
    szCSDVersion: array[0..127] of AnsiChar; { Maintenance string for PSS usage }
    wServicePackMajor,
    wServicePackMinor,
    wSuiteMask : word;
    wProductType,
    wReserved : byte;
  end;
  {$EXTERNALSYM _OSVERSIONINFOA}
  _OSVERSIONINFOW = record
    dwOSVersionInfoSize: DWORD;
    dwMajorVersion: DWORD;
    dwMinorVersion: DWORD;
    dwBuildNumber: DWORD;
    dwPlatformId: DWORD;
    szCSDVersion: array[0..127] of WideChar; { Maintenance string for PSS usage }
    wServicePackMajor,
    wServicePackMinor,
    wSuiteMask : word;
    wProductType,
    wReserved : byte;
  end;
  {$EXTERNALSYM _OSVERSIONINFOW}
  _OSVERSIONINFO = _OSVERSIONINFOA;
  TOSVersionInfoA = _OSVERSIONINFOA;
  TOSVersionInfoW = _OSVERSIONINFOW;
  TOSVersionInfo = TOSVersionInfoA;
  OSVERSIONINFOA = _OSVERSIONINFOA;
  {$EXTERNALSYM OSVERSIONINFOA}
  {$EXTERNALSYM OSVERSIONINFO}
  OSVERSIONINFOW = _OSVERSIONINFOW;
  {$EXTERNALSYM OSVERSIONINFOW}
  {$EXTERNALSYM OSVERSIONINFO}
  OSVERSIONINFO = OSVERSIONINFOA;

const
  {$EXTERNALSYM VERSIONINFOSIZEA}
  VERSIONINFOSIZEA = sizeof(TOSVersionInfoA) -
    (sizeof(word) * 3) - (sizeof(byte) * 2);
  {$EXTERNALSYM VERSIONINFOSIZEW}
  VERSIONINFOSIZEW = sizeof(TOSVersionInfoW) -
    (sizeof(word) * 3) - (sizeof(byte) * 2);
  {$EXTERNALSYM VERSIONINFOSIZE}
  VERSIONINFOSIZE = VERSIONINFOSIZEA;


const
  //
  // RtlVerifyVersionInfo() os product type values
  //
  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;
  VER_SUITE_EMBEDDED_RESTRICTED = $00000800;
  VER_SUITE_SECURITY_APPLIANCE = $00001000;




function GetVersionExA(var lpVersionInformation: TOSVersionInfo): BOOL; stdcall;
{$EXTERNALSYM GetVersionExA}
function GetVersionExW(var lpVersionInformation: TOSVersionInfo): BOOL; stdcall;
{$EXTERNALSYM GetVersionExW}
function GetVersionEx(var lpVersionInformation: TOSVersionInfo): BOOL; stdcall;
{$EXTERNALSYM GetVersionEx}

implementation

function GetVersionExA; external kernel32 name 'GetVersionExA';
function GetVersionExW; external kernel32 name 'GetVersionExW';
function GetVersionEx; external kernel32 name 'GetVersionExA';

end.

Unit1 :

uses Windows_Fragment

//

function GetWinVersion: string;
var
  osvi : TOSVersionInfo;
  bOsVersionInfoEx : boolean;
  key : HKEY;
  szProductType : array[0..79]of char;
  dwBuflen : dword;
begin
  ZeroMemory(@osvi,sizeof(TOSVersionInfo));
  osvi.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
  bOsVersionInfoEx := GetVersionEx(osvi);
  if(not bOsVersionInfoEx) then begin
    osvi.dwOSVersionInfoSize := VERSIONINFOSIZE;

    if(not GetVersionEx(osvi)) then begin
      Result := 'Error determining Windows Version!';
      exit;
    end;
  end;

  case osvi.dwPlatformId of
    VER_PLATFORM_WIN32_NT:
      begin
        if(osvi.dwMajorVersion = 5) and (osvi.dwMinorVersion = 2) then
          Result := 'Microsoft Windows Server 2003 family, ';

        if(osvi.dwMajorVersion = 5) and (osvi.dwMinorVersion = 1) then
          Result := 'Microsoft Windows XP ';

        if(osvi.dwMajorVersion = 5) and (osvi.dwMinorVersion = 0) then
          Result := 'Microsoft Windows 2000 ';

        if(osvi.dwMajorVersion <= 4) then
          Result := 'Microsoft Windows NT ';

        if(bOsVersionInfoEx) then begin
          if(osvi.wProductType = VER_NT_WORKSTATION) then begin
            if(osvi.dwMajorVersion = 4) then
              Result := Result + 'Workstation 4.0 '
            else if(osvi.wSuiteMask and VER_SUITE_PERSONAL <> 0) then
              Result := Result + 'Home Edition '
            else
              Result := Result + 'Professional ';
          end
          else if(osvi.wProductType = VER_NT_SERVER) then begin
            if(osvi.dwMajorVersion = 5) and
              (osvi.dwMinorVersion = 2) then
            begin
              if(osvi.wSuiteMask and VER_SUITE_DATACENTER <> 0) then
                Result := Result + 'Datacenter Edition '
              else if(osvi.wSuiteMask and VER_SUITE_ENTERPRISE <> 0) then
                Result := Result + 'Enterprise Edition '
              else if(osvi.wSuiteMask = VER_SUITE_BLADE) then
                Result := Result + 'Web Edition '
              else
                Result := Result + 'Standard Edition ';
            end
            else if(osvi.dwMajorVersion = 5) and
              (osvi.dwMinorVersion = 0) then
            begin
              if(osvi.wSuiteMask and VER_SUITE_DATACENTER <> 0) then
                Result := Result + 'Datacenter Server '
              else if(osvi.wSuiteMask and VER_SUITE_ENTERPRISE <> 0) then
                Result := Result + 'Advanced Server '
              else
                Result := Result + 'Server ';
            end
            else begin
              if(osvi.wSuiteMask and VER_SUITE_ENTERPRISE <> 0) then
                Result := Result + 'Server 4.0, Enterprise Edition '
              else
                Result := Result + 'Server 4.0 ';
            end;
          end
        end
        else begin
          dwBufLen := sizeof(szProductType);
          if(RegOpenKeyEx(HKEY_LOCAL_MACHINE,
            'SYSTEM\CurrentControlSet\Control\ProductOptions',0,
            KEY_QUERY_VALUE,key) = ERROR_SUCCESS) then
          try
            ZeroMemory(@szProductType,sizeof(szProductType));

            if(RegQueryValueEx(key,'ProductType',nil,nil,
              @szProductType,@dwBufLen) <> ERROR_SUCCESS) or
              (dwBufLen > sizeof(szProductType)) then
            ZeroMemory(@szProductType,sizeof(szProductType));
          finally
            RegCloseKey(key);
          end;

          if(lstrcmpi('WINNT',szProductType) = 0) then
            Result := Result + 'Workstation ';
          if(lstrcmpi('LANMANNT',szProductType) = 0) then
            Result := Result + 'Server ';
          if(lstrcmpi('SERVERNT',szProductType) = 0) then
            Result := Result + 'Advanced Server ';

          Result := Format('%s%d.%d',[Result,osvi.dwMajorVersion,
            osvi.dwMinorVersion]);
        end;

        if(osvi.dwMajorVersion = 4) and
          (lstrcmpi(osvi.szCSDVersion,'Service Pack 6') = 0) then
        begin
          if(RegOpenKeyEx(HKEY_LOCAL_MACHINE,
            'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Hotfix\Q246009',
            0,KEY_QUERY_VALUE,key) = ERROR_SUCCESS) then

            Result := Format('%sService Pack 6a (Build %d)',[Result,
              osvi.dwBuildNumber and $ffff])
          else
            Result := Format('%s%s (Build %d)',[Result,
              osvi.szCSDVersion,osvi.dwBuildNumber and $ffff]);
          RegCloseKey(key);
        end
        else begin
          Result := Format('%s%s (Build %d)',[Result,
            osvi.szCSDVersion,osvi.dwBuildNumber and $ffff]);
        end;
      end;
    VER_PLATFORM_WIN32_WINDOWS:
      begin
        if(osvi.dwMajorVersion = 4) and
          (osvi.dwMinorVersion = 0) then
        begin
          Result := 'Microsoft Windows 95 ';
          if(osvi.szCSDVersion[0] = 'C') or
            (osvi.szCSDVersion[0] = 'B') then Result := Result + 'OSR2 ';
        end;

        if(osvi.dwMajorVersion = 4) and
          (osvi.dwMinorVersion = 10) then
        begin
          Result := 'Microsoft Windows 98 ';
          if(osvi.szCSDVersion[0] = 'A') then Result:= Result + 'SE ';
        end;

        if(osvi.dwMajorVersion = 4) and
          (osvi.dwMinorVersion = 90) then
        begin
          Result := 'Microsoft Windows Millennium Edition';
        end;
      end;
    VER_PLATFORM_WIN32s:
      Result := 'Microsoft Win32s';
  end;
end;

Beispiel :

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text := GetWinVersion;
end;