ugetos.pas

DAD2.0 上传下传DAD2.0 上传下传DAD2.0 上传下传DAD2.0 上传下传

unit uGetOS;

interface
uses
  Windows, Messages, SysUtils, Classes;

type

  TOSVersion = (osUnknown, os95, os95OSR2, os98, os98SE, osNT3, osNT4, os2000, osME, osXP, os2003);
function GetOSString(): string;
function GetOS: TOSVersion;
function GetOSVersionText: string;

{$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} //   TOSVERSIONINFOEX_DEFINED

implementation

function GetOSString(): string;
var
  osv: TOSVersion;
begin
  result := 'Unknown';
  osv := GetOS();
  if osv = osXP then result := 'XP';
  if osv = os2000 then result := '2000';
  if osv = osNT4 then result := 'NT4';
  if osv = osNT3 then result := 'NT3';
  if osv = os2003 then result := '2003';
end;

function GetOS: TOSVersion;
var
  OS: TOSVersionInfo;
begin
  ZeroMemory(@OS, SizeOf(OS));
  OS.dwOSVersionInfoSize := SizeOf(OS);
  GetVersionEx(OS);
  Result := osUnknown;
  if OS.dwPlatformId = VER_PLATFORM_WIN32_NT then
  begin
    case OS.dwMajorVersion of
      3: Result := osNT3;
      4: Result := osNT4;
      5: Result := os2000;
    end;
    if (OS.dwMajorVersion = 5) and (OS.dwMinorVersion = 1) then
      Result := osXP;
    if (OS.dwMajorVersion = 5) and (OS.dwMinorVersion = 2) then
      Result := OS2003;

  end
  else
  begin
    if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 0) then
    begin
      Result := os95;
      if (Trim(OS.szCSDVersion) = 'B') then
        Result := os95OSR2;
    end
    else
      if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 10) then
      begin
        Result := os98;
        if (Trim(OS.szCSDVersion) = 'A') then
          Result := os98SE;
      end
      else
        if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 90) then
          Result := osME;
  end;
end;

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
    {   Win32s   }
    VER_PLATFORM_WIN32s:
      Result := 'Microsoft Win32s';
    {   Windows   9x   }
    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';
    {   Windows   NT   }
    VER_PLATFORM_WIN32_NT:
      begin
        {   Version   }
        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';
        {   Extended   }
        if (Info.dwOSVersionInfoSize >= SizeOf(TOSVersionInfoEx)) then
        begin
          {   ProductType   }
          if (Info.wProductType = VER_NT_WORKSTATION) then
          begin
            if (Info.dwMajorVersion = 4) then
              Result := Result + ',Workstation 4.0'
            else
              if (Info.wSuiteMask and VER_SUITE_PERSONAL <> 0) then
                Result := Result + ',Home Edition'
              else
                Result := Result + ',Professional';
          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 + ',Datacenter Edition'
                else
                  if (Info.wSuiteMask and VER_SUITE_ENTERPRISE <> 0) then
                    Result := Result + ',Enterprise Edition'
                  else
                    if (Info.wSuiteMask = VER_SUITE_BLADE) then
                      Result := Result + ',Web Edition'
                    else
                      Result := Result + ',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 + ',Datacenter Server'
                  else
                    if (Info.wSuiteMask and VER_SUITE_ENTERPRISE <> 0) then
                      Result := Result + ',Advanced Server'
                    else
                      Result := Result + ',Server';
                end
                else
                begin
                  Result := Result + ',Server ' +
                    IntToStr(Info.dwMajorVersion) + '.' +
                    IntToStr(Info.dwMinorVersion);
                  if (Info.wSuiteMask and VER_SUITE_ENTERPRISE <> 0) then
                    Result := Result + ', Enterprise Edition';
                end;
            end;
        end;
        {   CSDVersion   }
        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 + ',Service Pack 6a';
          RegCloseKey(Key);
        end
        else
          Result := Result + ','+ StrPas(Info.szCSDVersion);
        Result := Result + ' (Build ' +
          IntToStr(Info.dwBuildNumber and $FFFF) + ')';
      end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
end.