[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;

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179

{ **** 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.