[Admin]

Прислал: Ушаков Максим (MMX)
E-mail: msincster@gmail.com
-----------------------------

Обновление модуля
----------------------

>> Получение информации о типе и версии операционной системы

Опеределение типа установленной операционной системы

Зависимости: Windows

Автор: Игорь Шевченко, whitefranz@hotmail.com, Москва
Copyright: Игорь Шевченко
Дата: 26 апреля 2002 г.

-------------------------------------------------

– Добавлены типы серверных ОС и новые версии ОС Windows
– Добавлена перегруженная функция возврата номера версии "Major,Minor"

function WhatWindowsIsInstalled: string; overload;

function WhatWindowsIsInstalled(var Major:integer; var Minor:integer): string; overload;

Код:

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение информации о типе и версии операционной системы

Опеределение типа установленной операционной системы

Зависимости: Windows
Автор:       Игорь Шевченко, whitefranz@hotmail.com, Москва
Copyright:   Игорь Шевченко
Дата:        26 апреля 2002 г.
***************************************************** }

unit HSWinFuncs;

interface

uses
  Windows;

const
  VER_NT_WORKSTATION = 0;
  VER_NT_DOMAIN_CONTROLLER = 1;
  VER_NT_SERVER = 2;

  VER_SUITE_SMALLBUSINESS = 1;
  VER_SUITE_ENTERPRISE = 2;
  VER_SUITE_BACKOFFICE = 4;
  VER_SUITE_COMMUNICATIONS = 8;
  VER_SUITE_TERMINAL = $10;
  VER_SUITE_SMALLBUSINESS_RESTRICTED = $20;
  VER_SUITE_EMBEDDEDNT = $40;
  VER_SUITE_DATACENTER = $80;
  VER_SUITE_SINGLEUSERTS = $100;
  VER_SUITE_PERSONAL = $200;
  VER_SUITE_BLADE = $400;

type
  TOsVersionInfoExA = packed record
    old: TOsVersionInfoA;
    wServicePackMajor: Word;
    wServicePackMinor: Word;
    {
     wSuiteMask
     Набор битовых флагов, определяющих компоненты Windows
     VER_SUITE_BACKOFFICE Установлен компонент Microsoft BackOffice.
     VER_SUITE_BLADE Установлен компонент Windows .NET Web Server.
     VER_SUITE_DATACENTER Установлена Windows 2000 или компонент Windows .NET
       Datacenter Server
     VER_SUITE_ENTERPRISE Установлена Windows 2000 Advanced Server или компонент
       Windows .NET Enterprise Server.
     VER_SUITE_PERSONAL Установлена Windows XP Home Edition.
     VER_SUITE_SMALLBUSINESS Установлен Microsoft Small Business Server.
     VER_SUITE_SMALLBUSINESS_RESTRICTED Установлен Microsoft Small Business
       Server с ограничительной лицензией для клиентов
     VER_SUITE_TERMINAL Установлен компонент Terminal Services.
    }

    wSuiteMask: Word;
    {wProductType
    Дополнительная информация о типе операционной системы
    VER_NT_WORKSTATION Операционная система Windows NT 4.0 Workstation,
                                            Windows 2000 Professional,
                                            Windows XP Home Edition, или
                                            Windows XP Professional.
    VER_NT_DOMAIN_CONTROLLER Операционная система является контроллером домена.
    VER_NT_SERVER Операционная система является сервером.
    }

    wProductType: Byte;
    wReserved: Byte;
  end;

  function WhatWindowsIsInstalled: string; overload;
  function WhatWindowsIsInstalled(var Major:integer; var Minor:integer): string; overload;

implementation

{ Определение типа установленной операционной системы }

function WhatWindowsIsInstalled: string;
var
  VerInfo: TOsVersionInfoExA;
begin
  FillChar(VerInfo, sizeof(VerInfo), 0);
  VerInfo.old.dwOSVersionInfoSize := Sizeof(TOsVersionInfoExA);
  if not GetVersionExA(VerInfo.old) then
  begin
    VerInfo.old.dwOSVersionInfoSize := Sizeof(TOsVersionInfoA);
    GetVersionExA(VerInfo.old);
  end;
  case VerInfo.old.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS:
      if (Verinfo.old.dwMajorVersion = 4) and
        (Verinfo.old.dwBuildNumber = 950) then
        Result := 'Windows 95'
      else if (Verinfo.old.dwMajorVersion = 4) and
        (Verinfo.old.dwMinorVersion = 10) and
        (Verinfo.old.dwBuildNumber = 1998) then
        Result := 'Windows 98'
      else if (Verinfo.old.dwMinorVersion = 90) then
        Result := 'Windows Me';
    VER_PLATFORM_WIN32_NT:
      case Verinfo.old.dwMajorVersion of
        3: Result := 'Windows NT 3.51';
        4: Result := 'Windows NT 4.0';
        5: if Verinfo.old.dwMinorVersion = 0 then
            Result := 'Windows 2000'
           else if Verinfo.old.dwMinorVersion = 1 then
            Result := 'Windows XP'
           else if Verinfo.old.dwMinorVersion = 2 then
            Result := 'Windows XP 64bit';
        6: if Verinfo.old.dwMinorVersion = 0 then
            Result := 'Windows Vista'
           else if Verinfo.old.dwMinorVersion = 1 then
            Result := 'Windows Seven';
        end;
    VER_PLATFORM_WIN32s:
      case Verinfo.old.dwMajorVersion of
        5: if Verinfo.old.dwMinorVersion = 2 then
            Result := 'Windows Server 2003';
        6: if Verinfo.old.dwMinorVersion = 0 then
            Result := 'Windows Server 2008'
           else if Verinfo.old.dwMinorVersion = 1 then
            Result := 'Windows Server 2008 R2';
      end;
  end;
end;

function WhatWindowsIsInstalled(var Major:integer; var Minor:integer): string; overload;
var
  VerInfo: TOsVersionInfoExA;
begin
  FillChar(VerInfo, sizeof(VerInfo), 0);
  VerInfo.old.dwOSVersionInfoSize := Sizeof(TOsVersionInfoExA);
  if not GetVersionExA(VerInfo.old) then
  begin
    VerInfo.old.dwOSVersionInfoSize := Sizeof(TOsVersionInfoA);
    GetVersionExA(VerInfo.old);
  end;
  case VerInfo.old.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS:
      if (Verinfo.old.dwMajorVersion = 4) and
        (Verinfo.old.dwBuildNumber = 950) then
        Result := 'Windows 95'
      else if (Verinfo.old.dwMajorVersion = 4) and
        (Verinfo.old.dwMinorVersion = 10) and
        (Verinfo.old.dwBuildNumber = 1998) then
        Result := 'Windows 98'
      else if (Verinfo.old.dwMinorVersion = 90) then
        Result := 'Windows Me';
    VER_PLATFORM_WIN32_NT:
      case Verinfo.old.dwMajorVersion of
        3: Result := 'Windows NT 3.51';
        4: Result := 'Windows NT 4.0';
        5: if Verinfo.old.dwMinorVersion = 0 then
            Result := 'Windows 2000'
           else if Verinfo.old.dwMinorVersion = 1 then
            Result := 'Windows XP'
           else if Verinfo.old.dwMinorVersion = 2 then
            Result := 'Windows XP 64bit';
        6: if Verinfo.old.dwMinorVersion = 0 then
            Result := 'Windows Vista'
           else if Verinfo.old.dwMinorVersion = 1 then
            Result := 'Windows Seven';
        end;
    VER_PLATFORM_WIN32s:
      case Verinfo.old.dwMajorVersion of
        5: if Verinfo.old.dwMinorVersion = 2 then
            Result := 'Windows Server 2003';
        6: if Verinfo.old.dwMinorVersion = 0 then
            Result := 'Windows Server 2008'
           else if Verinfo.old.dwMinorVersion = 1 then
            Result := 'Windows Server 2008 R2';
      end;
  end;
  Major:=Verinfo.old.dwMajorVersion;
  Minor:=Verinfo.old.dwMinorVersion;
 end;

end.