kjkim
/
BSOne.SFC
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
BSOne.SFC/Tocsg.Lib/VCL/Other/EM.WinOSVersion.pas

796 lines
28 KiB
Plaintext
Raw Blame History

//---------------------------------------------------------------------
// Windows Version Pascal Source
//
// Create by: Kang Sin-young (2004.01.25 Last Modify)
//---------------------------------------------------------------------
//---------------------------------------------------------------------
// GetWindowsVersion Pascal Source
// From https://github.com/yypbd/yypbd-Delphi-Libs/blob/master/lib/WindowsVersion.pas
// Create by: Young-pil Yang (2014.05.28 Last Modify)
//---------------------------------------------------------------------
unit EM.WinOSVersion;
interface
uses
WinApi.Windows, WinApi.Messages, SysUtils, Variants, StrUtils, System.Win.Registry;
type
TGetProductInfo = function (dwOsMajorVer, dwOSMinorVerion, dwSpMajorVer, dwSpMinorVer : DWORD; pdwReturnProductType : PDWORD):Boolean; stdcall;
WKSTA_INFO_100 = record
wki100_platform_id: DWORD;
wki100_computername: LPWSTR;
wki100_langroup: LPWSTR;
wki100_ver_major: DWORD;
wki100_ver_minor: DWORD;
end;
LPWKSTA_INFO_100 = ^WKSTA_INFO_100;
_USER_INFO_0 = record
usri0_name: LPWSTR;
end;
TWinVerSub = record
Major,
Minor,
Build: DWORD;
end;
TWinVerInfo = record
WinID,
WinVer,
WinName,
ServicePack: String;
Version: TWinVerSub;
end;
_OSVERSIONINFOEXA = record
dwOSVersionInfoSize: DWORD;
dwMajorVersion: DWORD;
dwMinorVersion: DWORD;
dwBuildNumber: DWORD;
dwPlatformId: DWORD;
szCSDVersion: array[0..127] of AnsiChar; { Maintenance string for PSS usage }
wServicePackMajor: WORD;
wServicePackMinor: WORD;
wSuiteMask: WORD;
wProductType: BYTE;
wReserved: BYTE;
end;
{$EXTERNALSYM _OSVERSIONINFOEXA}
_OSVERSIONINFOEXW = record
dwOSVersionInfoSize: DWORD;
dwMajorVersion: DWORD;
dwMinorVersion: DWORD;
dwBuildNumber: DWORD;
dwPlatformId: DWORD;
szCSDVersion: array[0..127] of WideChar; { Maintenance string for PSS usage }
wServicePackMajor: WORD;
wServicePackMinor: WORD;
wSuiteMask: WORD;
wProductType: BYTE;
wReserved: BYTE;
end;
{$EXTERNALSYM _OSVERSIONINFOEXW}
OSVERSIONINFOEXA = _OSVERSIONINFOEXA;
OSVERSIONINFOEXW = _OSVERSIONINFOEXW;
{$EXTERNALSYM OSVERSIONINFOEXA}
{$EXTERNALSYM OSVERSIONINFOEXW}
OSVERSIONINFOEX = OSVERSIONINFOEXA;
{$EXTERNALSYM OSVERSIONINFOEX}
TOSVersionInfoExA = OSVERSIONINFOEXA;
TOSVersionInfoExW = OSVERSIONINFOEXW;
const
NERR_Success = 0;
SERVICE_MAX_COUNT = 10;
VER_EQUAL = 1;
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}
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}
//GetProductInfo vista 이상에서만 사용
PRODUCT_BUSINESS = $00000006;
PRODUCT_BUSINESS_N = $00000010;
PRODUCT_CLUSTER_SERVER = $00000012;
PRODUCT_DATACENTER_SERVER = $00000008;
PRODUCT_DATACENTER_SERVER_CORE = $0000000C;
PRODUCT_DATACENTER_SERVER_CORE_V = $00000027;
PRODUCT_DATACENTER_SERVER_V = $00000025;
PRODUCT_ENTERPRISE = $00000004;
PRODUCT_ENTERPRISE_E = $00000046;
PRODUCT_ENTERPRISE_N = $0000001B;
PRODUCT_ENTERPRISE_SERVER = $0000000A;
PRODUCT_ENTERPRISE_SERVER_CORE = $0000000E;
PRODUCT_ENTERPRISE_SERVER_CORE_V = $00000029;
PRODUCT_ENTERPRISE_SERVER_IA64 = $0000000F;
PRODUCT_ENTERPRISE_SERVER_V = $00000026;
PRODUCT_HOME_BASIC = $00000002;
PRODUCT_HOME_BASIC_E = $00000043;
PRODUCT_HOME_BASIC_N = $00000005;
PRODUCT_HOME_PREMIUM = $00000003;
PRODUCT_ULTIMATE = $00000001;
PRODUCT_PROFESSIONAL = $00000030;
PRODUCT_PROFESSIONAL_N = $00000031;
PRODUCT_STARTER = $0000000B;
PRODUCT_SMALLBUSINESS_SERVER = $00000009;
PRODUCT_SMALLBUSINESS_SERVER_PREMIUM = $00000019;
PRODUCT_STANDARD_SERVER = $00000007;
PRODUCT_STANDARD_SERVER_CORE = $0000000D;
PRODUCT_WEB_SERVER = $00000011;
var
MajorCache: DWORD;
MinorCache: DWORD;
ServicePackCache: DWORD;
IsServerCache: Boolean;
function NetWkstaGetInfo(ServerName: LPWSTR; Level: DWORD; BufPtr: Pointer)
: Longint; stdcall; external 'netapi32.dll' Name 'NetWkstaGetInfo';
function NetApiBufferFree(Buffer: Pointer): Longint; stdcall;
external 'netapi32.dll' Name 'NetApiBufferFree';
{$IFDEF UNICODE}
function VerifyVersionInfo(var LPOSVERSIONINFOEX: OSVERSIONINFOEX;
dwTypeMask: DWORD; dwlConditionMask: int64): BOOL; stdcall;
external kernel32 name 'VerifyVersionInfoW';
{$ELSE}
function VerifyVersionInfo(var LPOSVERSIONINFOEX: OSVERSIONINFOEX;
dwTypeMask: DWORD; dwlConditionMask: int64): BOOL; stdcall;
external kernel32 name 'VerifyVersionInfoA';
{$ENDIF}
function VerSetConditionMask(dwlConditionMask: int64; dwTypeBitMask: DWORD;
dwConditionMask: Byte): int64; stdcall; external kernel32;
function GetVersionEx2(var lpVersionInformation: TOSVersionInfoExA): BOOL; stdcall;
{$EXTERNALSYM GetVersionEx2}
function GetVersionEx2A(var lpVersionInformation: TOSVersionInfoExA): BOOL; stdcall;
{$EXTERNALSYM GetVersionEx2A}
function GetVersionEx2W(var lpVersionInformation: TOSVersionInfoExW): BOOL; stdcall;
{$EXTERNALSYM GetVersionEx2W}
function GetWindowsVersion(var AMajor, AMinor: DWORD): Boolean; overload;
function GetWindowsVersion(var AMajor, AMinor, AServicePack, ABuildNumber: DWORD;
var AIsServer: Boolean): Boolean; overload;
function GetWinVersion: TWinVerInfo;
function ParseWinNT(p: TOSVersionInfoExW; IsEx: Boolean): TWinVerInfo; overload;
function ParseWinNT(p: TOSVersionInfoExA; IsEx: Boolean): TWinVerInfo; overload;
function ParseWin9x(p: TOSVersionInfo): TWinVerInfo;
implementation
uses
System.Classes, Tocsg.Safe, Tocsg.Path, Tocsg.Strings, Tocsg.Registry,
Tocsg.FileInfo;
function GetVersionEx2; external kernel32 name 'GetVersionExA';
function GetVersionEx2A; external kernel32 name 'GetVersionExA';
function GetVersionEx2W; external kernel32 name 'GetVersionExW';
function GetWinVersion: TWinVerInfo;
var
rtnVerEx: TOSVersionInfoExA;
rtnVer: TOSVersionInfo;
rtnParse: TWinVerInfo;
begin
rtnVer.dwOSVersionInfoSize := sizeof(OSVERSIONINFO); //Get 1st OS Info
GetVersionEx(rtnVer);
if rtnVer.dwPlatformId = VER_PLATFORM_WIN32_NT then
begin
if rtnVer.dwMajorVersion < 5 then
rtnParse := ParseWinNT(rtnVerEx, False)
else begin
rtnVerEx.dwOSVersionInfoSize := sizeof(TOSVersionInfoExA); //*WinNT/2000/XP/2003
GetVersionEx2(rtnVerEx);
rtnParse := ParseWinNT(rtnVerEx, True);
end;
end else
rtnParse := ParseWin9x(rtnVer);
Result := rtnParse;
end;
function ParseWinNT(p: TOSVersionInfoExA; IsEx: Boolean): TWinVerInfo;
function IsWin11: Boolean;
var
fi: TTgFileInfo;
StrList: TStringList;
begin
Result := false;
Guard(fi, TTgFileInfo.Create(GetSystemDir + 'kernel32.dll'));
Guard(StrList, TStringList.Create);
if SplitString(fi.Version, '.', StrList) > 3 then
begin
if StrToIntDef(StrList[2], -1) >= 22000 then
Result := true;
end;
end;
var
rtn: TWinVerInfo;
resVer: TRegistry;
szProduct: String;
procGetProductInfo : TGetProductInfo;
hModule : THandle;
ProdType : DWORD;
dwMajor, dwMinor, dwService, dwBuildNum : DWORD;
bIsServer : Boolean;
begin
GetWindowsVersion(dwMajor, dwMinor, dwService, dwBuildNum, bIsServer);
p.dwMajorVersion := dwMajor;
p.dwMinorVersion := dwMinor;
p.dwBuildNumber := dwBuildNum;
if not bIsServer then
begin
p.wProductType := VER_NT_WORKSTATION
end;
// 윈도우 8.0이 추가 되면서 다시 개선함
rtn.WinVer := 'Unknown';
case p.dwMajorVersion of
5 :
case p.dwMinorVersion of
0 : rtn.WinName := '2000';
1 : rtn.WinName := 'XP';
2 : rtn.WinName := '2003 Server Family';
end;
6 :
case p.dwMinorVersion of
0 :
if p.wProductType = VER_NT_WORKSTATION then
rtn.WinVer := 'Vista'
else
rtn.WinVer := 'Server 2008';
1 :
if p.wProductType = VER_NT_WORKSTATION then
rtn.WinVer := '7'
else
rtn.WinVer := 'Server 2008 R2';
2 : // 윈 8 정보 추가
if p.wProductType = VER_NT_WORKSTATION then
rtn.WinVer := '8'
else
rtn.WinVer := 'Server 2012';
3 : // 윈 8 정보 추가
if p.wProductType = VER_NT_WORKSTATION then
rtn.WinVer := '8.1'
else
rtn.WinVer := 'Server 2012 R2';
end;
10 :
begin
// 윈도우 10
rtn.WinVer := '10';
case p.dwMinorVersion of
0 : ; // .. 하위 정보 확인 필요
end;
// windows 11의 공식 메이저 버전은 10이다..
// 11인걸 판단하기 위해 'kernel32.dll'의 빌드번호가 22000 이상인지 확인한다. 22_0517 10:05:21 kku
if IsWin11 then
rtn.WinVer := '11';
end;
0 :
begin
// 안전모드에서는 실패한다. 22_1116 13:11:54 kku
rtn.WinVer := ExtrNumStr(GetRegValueAsString(HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'ProductName'));
if rtn.WinVer = '10' then
begin
if IsWin11 then
rtn.WinVer := '11';
end else
if rtn.WinVer = '' then
rtn.WinVer := '?';
end;
end;
rtn.WinName := 'Windows ' + rtn.WinVer;
//Get Product Substring
if (IsEX) then begin
case p.wProductType of
VER_NT_WORKSTATION:
begin
if (p.dwMajorVersion = 4) then
rtn.WinName := rtn.WinName + ' Workstation 4.0'
else if (p.wSuiteMask and VER_SUITE_PERSONAL) = VER_SUITE_PERSONAL then
rtn.WinName := rtn.WinName + ' Home Edition'
else if p.dwMajorVersion = 6 then
begin
// 비스타의 경우.. 버전정보를 모르겠다.. 아직은..
end
else
rtn.WinName := rtn.WinName + ' Professional';
end;
VER_NT_SERVER:
begin
if ((p.dwMajorVersion = 5) and (p.dwMinorVersion = 2)) then begin
if (p.wSuiteMask and VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER then
rtn.WinName := rtn.WinName + ' Datacenter Edition'
else if (p.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
rtn.WinName := rtn.WinName + ' Enterprise Edition'
else if (p.wSuiteMask and VER_SUITE_BLADE) = VER_SUITE_BLADE then
rtn.WinName := rtn.WinName + ' Web Edition'
else
rtn.WinName := rtn.WinName + ' Standard Edition';
end
else if ((p.dwMajorVersion = 5) and (p.dwMinorVersion = 0)) then begin
if (p.wSuiteMask and VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER then
rtn.WinName := rtn.WinName + ' Datacenter Server'
else if (p.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
rtn.WinName := rtn.WinName + ' Advanced Server'
else
rtn.WinName := rtn.WinName + ' Server';
end
else if (p.dwMajorVersion = 6) then
else begin
if (p.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
rtn.WinName := rtn.WinName + ' Server 4.0 Enterprise Edition'
else
rtn.WinName := rtn.WinName + ' Server 4.0';
end;
end;
end; {case of}
if p.dwMajorVersion = 6 then
begin
hModule := GetModuleHandle('kernel32.dll');
procGetProductInfo := GetProcAddress( hModule ,'GetProductInfo');
if Assigned(procGetProductInfo) then
begin
procGetProductInfo(p.dwMajorVersion, p.dwMinorVersion, 0, 0, @ProdType);
case ProdType of
PRODUCT_ULTIMATE : rtn.WinName := rtn.WinName + ' Ultimate';
PRODUCT_PROFESSIONAL : rtn.WinName := rtn.WinName + ' Professional';
PRODUCT_HOME_PREMIUM : rtn.WinName := rtn.WinName + ' Home Premium Edition';
PRODUCT_HOME_BASIC : rtn.WinName := rtn.WinName + ' Home Basic Edition';
PRODUCT_ENTERPRISE : rtn.WinName := rtn.WinName + ' Enterprise Edition';
PRODUCT_BUSINESS : rtn.WinName := rtn.WinName + ' Business Edition';
PRODUCT_STARTER : rtn.WinName := rtn.WinName + ' Starter Edition';
PRODUCT_CLUSTER_SERVER : rtn.WinName := rtn.WinName + ' Cluster Server Edition';
PRODUCT_DATACENTER_SERVER : rtn.WinName := rtn.WinName + ' Datacenter Edition';
PRODUCT_DATACENTER_SERVER_CORE : rtn.WinName := rtn.WinName + ' Datacenter Edition (core installation)';
PRODUCT_ENTERPRISE_SERVER : rtn.WinName := rtn.WinName + ' Enterprise Edition';
PRODUCT_ENTERPRISE_SERVER_CORE : rtn.WinName := rtn.WinName + ' Enterprise Edition (core installation)';
PRODUCT_ENTERPRISE_SERVER_IA64 : rtn.WinName := rtn.WinName + ' Enterprise Edition for Itanium-based Systems)';
PRODUCT_SMALLBUSINESS_SERVER : rtn.WinName := rtn.WinName + ' Small Business Server';
PRODUCT_SMALLBUSINESS_SERVER_PREMIUM : rtn.WinName := rtn.WinName + ' Small Business Server Premium Edition';
PRODUCT_STANDARD_SERVER : rtn.WinName := rtn.WinName + ' Standard Edition';
PRODUCT_STANDARD_SERVER_CORE : rtn.WinName := rtn.WinName + ' Standard Edition (core installation)';
PRODUCT_WEB_SERVER : rtn.WinName := rtn.WinName + ' Web Server Edition';
end;
FreeModule(hModule);
end;
end;
end {If IsEx}
else begin
// Test for specific product on Windows NT 4.0 SP5 and earlier
resVer := TRegistry.Create(KEY_READ);
try
resVer.RootKey := HKEY_LOCAL_MACHINE;
resver.OpenKeyReadOnly('SYSTEM\\CurrentControlSet\\Control\\ProductOptions');
szProduct := resVer.ReadString('ProductType');
if (Strcomp('WINNT', PChar(szProduct)) = 0) then
rtn.WinName := rtn.WinName + ' Workstation '
else if (Strcomp('LANMANNT', PChar(szProduct)) = 0) then
rtn.WinName := rtn.WinName + ' Server '
else if (Strcomp('SERVERNT', PChar(szProduct)) = 0) then
rtn.WinName := rtn.WinName + ' Advanced Server ';
rtn.WinName := rtn.WinName + IntToStr(p.dwMajorVersion) + '.' + IntToStr(p.dwMinorVersion);
finally
resVer.Free;
end;
end;{else IsEx}
//Get Version
rtn.Version.Major := p.dwMajorVersion;
rtn.Version.Minor := p.dwMinorVersion;
rtn.Version.Build := p.dwBuildNumber;
//Get Service Pack
if ((p.dwMajorVersion = 4) and (lstrcmpiA(p.szCSDVersion, 'Service Pack 6' ) = 0)) then begin
// Test for SP6 versus SP6a.
resVer := TRegistry.Create(KEY_READ);
try
resVer.RootKey := HKEY_LOCAL_MACHINE;
if resVer.OpenKeyReadOnly('SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Hotfix\\Q246009') then
rtn.ServicePack := 'Service Pack 6a'
else
rtn.ServicePack := String(p.szCSDVersion); //warring 제거
finally
resVer.Free;
end;
end
else
//Else Other All Version
if Boolean(p.wServicePackMajor) or Boolean(p.wServicePackMinor) then begin
rtn.ServicePack := 'Service Pack ' + intToStr(p.wServicePackMajor);
if Boolean(p.wServicePackMinor) then
rtn.ServicePack := rtn.ServicePack + '.' + IntToStr(p.wServicePackMinor);
end
else
rtn.ServicePack := String(p.szCSDVersion);
//Create ID String and Return
rtn.WinID := 'Microsoft ' + rtn.WinName + '(Version ' + IntToStr(rtn.Version.Major) + '.' + IntToStr(rtn.Version.Minor)
+ ' Build ' + IntToStr(rtn.Version.Build) + ') ' + rtn.ServicePack;
Result := rtn;
end;
function ParseWinNT(p: TOSVersionInfoExW; IsEx: Boolean): TWinVerInfo;
var
rtn: TWinVerInfo;
resVer: TRegistry;
szProduct: String;
procGetProductInfo : TGetProductInfo;
hModule : THandle;
ProdType : DWORD;
dwMajor, dwMinor, dwService, dwBuildNum : DWORD;
bIsServer : Boolean;
begin
GetWindowsVersion(dwMajor, dwMinor, dwService, dwBuildNum, bIsServer);
p.dwMajorVersion := dwMajor;
p.dwMinorVersion := dwMinor;
p.dwBuildNumber := dwBuildNum;
if not bIsServer then
begin
p.wProductType := VER_NT_WORKSTATION
end;
//Get Windows Product
if p.dwMajorVersion = 5 then begin
if p.dwMinorVersion = 2 then
rtn.WinName := 'Windows 2003 Server Family'
else if p.dwMinorVersion = 1 then
rtn.WinName := 'Windows XP'
else if p.dwMinorVersion = 0 then
rtn.WinName := 'Windows 2000';
end
else if p.dwMajorVersion = 6 then
if p.dwMinorVersion = 1 then
begin
if p.wProductType = VER_NT_WORKSTATION then
rtn.WinName := 'Windows 7'
else rtn.WinName := 'Windows Server 2008 R2';
end else if p.dwMinorVersion = 0 then
begin
if p.wProductType = VER_NT_WORKSTATION then
rtn.WinName := 'Windows Vista'
else rtn.WinName := 'Windows Server 2008';
end
else
rtn.WinName := 'Windows NT';
//Get Product Substring
if (IsEX) then begin
case p.wProductType of
VER_NT_WORKSTATION:
begin
if (p.dwMajorVersion = 4) then
rtn.WinName := rtn.WinName + ' Workstation 4.0'
else if (p.wSuiteMask and VER_SUITE_PERSONAL) = VER_SUITE_PERSONAL then
rtn.WinName := rtn.WinName + ' Home Edition'
else if p.dwMajorVersion = 6 then
begin
// 비스타의 경우.. 버전정보를 모르겠다.. 아직은..
end else
rtn.WinName := rtn.WinName + ' Professional';
end;
VER_NT_SERVER:
begin
if ((p.dwMajorVersion = 5) and (p.dwMinorVersion = 2)) then begin
if (p.wSuiteMask and VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER then
rtn.WinName := rtn.WinName + ' Datacenter Edition'
else if (p.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
rtn.WinName := rtn.WinName + ' Enterprise Edition'
else if (p.wSuiteMask and VER_SUITE_BLADE) = VER_SUITE_BLADE then
rtn.WinName := rtn.WinName + ' Web Edition'
else
rtn.WinName := rtn.WinName + ' Standard Edition';
end
else if ((p.dwMajorVersion = 5) and (p.dwMinorVersion = 0)) then begin
if (p.wSuiteMask and VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER then
rtn.WinName := rtn.WinName + ' Datacenter Server'
else if (p.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
rtn.WinName := rtn.WinName + ' Advanced Server'
else
rtn.WinName := rtn.WinName + ' Server';
end
else if (p.dwMajorVersion = 6) then
else begin
if (p.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
rtn.WinName := rtn.WinName + ' Server 4.0 Enterprise Edition'
else
rtn.WinName := rtn.WinName + ' Server 4.0';
end;
end;
end; {case of}
if p.dwMajorVersion = 6 then
begin
hModule := GetModuleHandle('kernel32.dll');
procGetProductInfo := GetProcAddress( hModule ,'GetProductInfo');
if Assigned(procGetProductInfo) then
begin
procGetProductInfo(p.dwMajorVersion, p.dwMinorVersion, 0, 0, @ProdType);
case ProdType of
PRODUCT_ULTIMATE : rtn.WinName := rtn.WinName + ' Ultimate';
PRODUCT_PROFESSIONAL : rtn.WinName := rtn.WinName + ' Professional';
PRODUCT_HOME_PREMIUM : rtn.WinName := rtn.WinName + ' Home Premium Edition';
PRODUCT_HOME_BASIC : rtn.WinName := rtn.WinName + ' Home Basic Edition';
PRODUCT_ENTERPRISE : rtn.WinName := rtn.WinName + ' Enterprise Edition';
PRODUCT_BUSINESS : rtn.WinName := rtn.WinName + ' Business Edition';
PRODUCT_STARTER : rtn.WinName := rtn.WinName + ' Starter Edition';
PRODUCT_CLUSTER_SERVER : rtn.WinName := rtn.WinName + ' Cluster Server Edition';
PRODUCT_DATACENTER_SERVER : rtn.WinName := rtn.WinName + ' Datacenter Edition';
PRODUCT_DATACENTER_SERVER_CORE : rtn.WinName := rtn.WinName + ' Datacenter Edition (core installation)';
PRODUCT_ENTERPRISE_SERVER : rtn.WinName := rtn.WinName + ' Enterprise Edition';
PRODUCT_ENTERPRISE_SERVER_CORE : rtn.WinName := rtn.WinName + ' Enterprise Edition (core installation)';
PRODUCT_ENTERPRISE_SERVER_IA64 : rtn.WinName := rtn.WinName + ' Enterprise Edition for Itanium-based Systems)';
PRODUCT_SMALLBUSINESS_SERVER : rtn.WinName := rtn.WinName + ' Small Business Server';
PRODUCT_SMALLBUSINESS_SERVER_PREMIUM : rtn.WinName := rtn.WinName + ' Small Business Server Premium Edition';
PRODUCT_STANDARD_SERVER : rtn.WinName := rtn.WinName + ' Standard Edition';
PRODUCT_STANDARD_SERVER_CORE : rtn.WinName := rtn.WinName + ' Standard Edition (core installation)';
PRODUCT_WEB_SERVER : rtn.WinName := rtn.WinName + ' Web Server Edition';
end;
FreeModule(hModule);
end;
end;
end {If IsEx}
else begin
// Test for specific product on Windows NT 4.0 SP5 and earlier
resVer := TRegistry.Create(KEY_READ);
try
resVer.RootKey := HKEY_LOCAL_MACHINE;
resver.OpenKeyReadOnly('SYSTEM\\CurrentControlSet\\Control\\ProductOptions');
szProduct := resVer.ReadString('ProductType');
if (Strcomp('WINNT', PChar(szProduct)) = 0) then
rtn.WinName := rtn.WinName + ' Workstation '
else if (Strcomp('LANMANNT', PChar(szProduct)) = 0) then
rtn.WinName := rtn.WinName + ' Server '
else if (Strcomp('SERVERNT', PChar(szProduct)) = 0) then
rtn.WinName := rtn.WinName + ' Advanced Server ';
rtn.WinName := rtn.WinName + IntToStr(p.dwMajorVersion) + '.' + IntToStr(p.dwMinorVersion);
finally
resVer.Free;
end;
end;{else IsEx}
//Get Version
rtn.Version.Major := p.dwMajorVersion;
rtn.Version.Minor := p.dwMinorVersion;
rtn.Version.Build := (p.dwBuildNumber and $FFFF);
//Get Service Pack
if ((p.dwMajorVersion = 4) and (lstrcmpW(p.szCSDVersion, 'Service Pack 6' ) = 0)) then begin
// Test for SP6 versus SP6a.
resVer := TRegistry.Create(KEY_READ);
try
resVer.RootKey := HKEY_LOCAL_MACHINE;
if resVer.OpenKeyReadOnly('SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Hotfix\\Q246009') then
rtn.ServicePack := 'Service Pack 6a'
else
rtn.ServicePack := p.szCSDVersion;
finally
resVer.Free;
end;
end
else
//Else Other All Version
if Boolean(p.wServicePackMajor) or Boolean(p.wServicePackMinor) then begin
rtn.ServicePack := 'Service Pack ' + intToStr(p.wServicePackMajor);
if Boolean(p.wServicePackMinor) then
rtn.ServicePack := rtn.ServicePack + '.' + IntToStr(p.wServicePackMinor);
end
else
rtn.ServicePack := p.szCSDVersion;
//Create ID String and Return
rtn.WinID := 'Microsoft ' + rtn.WinName + #10#13'(Version ' + IntToStr(rtn.Version.Major) + '.' + IntToStr(rtn.Version.Minor)
+ ' Build ' + IntToStr(rtn.Version.Build) + ') ' + rtn.ServicePack;
Result := rtn;
end;
function ParseWin9x(p: TOSVersionInfo): TWinVerInfo;
var
rtn: TWinVerInfo;
begin
if ((p.dwMajorVersion = 4) and (p.dwMinorVersion = 0)) then begin
rtn.WinName := 'Windows 95';
if ((p.szCSDVersion[1] = 'C') or (p.szCSDVersion[1] = 'B')) then
rtn.WinName := rtn.WinName + ' OSR2';
end
else if ((p.dwMajorVersion = 4) and (p.dwMinorVersion = 10)) then begin
rtn.WinName := 'Windows 98';
if (p.szCSDVersion[1] = 'A') then
rtn.WinName := rtn.WinName + ' SE';
end
else if ((p.dwMajorVersion = 4) and (p.dwMinorVersion = 90)) then
rtn.WinName := 'Windows Millennium Edition';
rtn.Version.Major := p.dwMajorVersion;
rtn.Version.Minor := p.dwMinorVersion;
rtn.Version.Build := (p.dwBuildNumber and $FFFF);
rtn.ServicePack := p.szCSDVersion;
if ((p.szCSDVersion[1] = 'C') or (p.szCSDVersion[1] = 'B') or (p.szCSDVersion[1] = 'A')) then
rtn.ServicePack := RightStr(rtn.ServicePack, Length(rtn.ServicePack) - 2);
//Create ID String and Return
rtn.WinID := 'Microsoft ' + rtn.WinName + #10#13'(Version ' + IntToStr(rtn.Version.Major) + '.' + IntToStr(rtn.Version.Minor)
+ ' Build ' + IntToStr(rtn.Version.Build) + ') ' + rtn.ServicePack;
Result := rtn;
end;
function GetWindowsVersion(var AMajor, AMinor: DWORD): Boolean;
var
Buf: LPWKSTA_INFO_100;
begin
Result := False;
if MajorCache <> 0 then
begin
AMajor := MajorCache;
AMinor := MinorCache;
Result := True;
Exit;
end;
if NetWkstaGetInfo(nil, 100, @Buf) = NERR_Success then
begin
MajorCache := Buf.wki100_ver_major;
AMajor := MajorCache;
MinorCache := Buf.wki100_ver_minor;
AMinor := MinorCache;
NetApiBufferFree(Buf);
Result := True;
end;
end;
function GetWindowsVersion(var AMajor, AMinor, AServicePack, ABuildNumber: DWORD;
var AIsServer: Boolean): Boolean; overload;
var
I: Integer;
osvi: OSVERSIONINFOEX;
ConditionMask: LONGLONG;
begin
Result := False;
AMajor := 0;
AMinor := 0;
AServicePack := 0;
ABuildNumber := 0;
if not GetWindowsVersion(AMajor, AMinor) then
exit;
if ServicePackCache <> MAXDWORD then
begin
AServicePack := ServicePackCache;
AIsServer := IsServerCache;
Result := True;
Exit;
end;
ZeroMemory(@osvi, SizeOf(OSVERSIONINFOEX));
osvi.dwOSVersionInfoSize := SizeOf(OSVERSIONINFOEX);
ConditionMask := 0;
ConditionMask := VerSetConditionMask(ConditionMask, VER_SERVICEPACKMAJOR, VER_EQUAL);
for I := 0 to SERVICE_MAX_COUNT - 1 do
begin
osvi.wServicePackMajor := I;
if VerifyVersionInfo(osvi, VER_SERVICEPACKMAJOR, ConditionMask) then
begin
ServicePackCache := I;
AServicePack := ServicePackCache;
ZeroMemory(@osvi, SizeOf(OSVERSIONINFOEX));
osvi.dwOSVersionInfoSize := SizeOf(OSVERSIONINFOEX);
osvi.wProductType := VER_NT_SERVER;
ConditionMask := 0;
ConditionMask := VerSetConditionMask(ConditionMask, VER_PRODUCT_TYPE,
VER_EQUAL);
IsServerCache := VerifyVersionInfo(osvi, VER_PRODUCT_TYPE, ConditionMask);
AIsServer := IsServerCache;
Result := True;
break;
end;
end;
ConditionMask := 0;
ConditionMask := VerSetConditionMask(ConditionMask, VER_BUILDNUMBER,
VER_EQUAL);
for I := 0 to 10000 do
begin
osvi.dwBuildNumber := I;
if VerifyVersionInfo(osvi, VER_BUILDNUMBER, ConditionMask) then
begin
ABuildNumber := I;
Result := True;
Exit;
end;
end;
end;
initialization
MajorCache := 0;
MinorCache := 0;
ServicePackCache := MAXDWORD;
IsServerCache := False;
end.
Reference in New Issue View Git Blame Copy Permalink