5
5
*
6
6
* Copyright (C) 2001-2015, Peter Johnson (@delphidabbler).
7
7
*
8
- * $Rev$
9
- * $Date$
8
+ * $Rev: 2002 $
9
+ * $Date: 2015-11-30 14:45:35 +0000 (Mon, 30 Nov 2015) $
10
10
*
11
11
* This unit contains various static classes, constants, type definitions and
12
12
* global variables for use in providing information about the host computer and
27
27
* OS. When run on Windows 8.1 and later details of the actual host
28
28
* operating system are always returned and the emulated OS is ignored.
29
29
*
30
- * 4: ** IMPORTANT **
31
- * This version of the code was an attempt to get it to detect and report
32
- * Windows 10. Try as I might, I can't get this to work. So this version
33
- * is released as beta code to use at your own risk. If anyone can fix it,
34
- * please let me know.
35
- *
36
30
* ACKNOWLEDGEMENTS
37
31
*
38
32
* Thanks to the following who have contributed to this project:
@@ -576,11 +570,25 @@ TPJOSInfo = class(TObject)
576
570
class function MinorVersion : Integer;
577
571
578
572
// / <summary>Returns the host OS's build number.</summary>
573
+ // / <remarks>A return value of 0 indicates that the build number can't be
574
+ // / found.</remarks>
579
575
class function BuildNumber : Integer;
580
576
581
577
// / <summary>Returns the name of any installed OS service pack.</summary>
582
578
class function ServicePack : string;
583
579
580
+ // / <summary>Returns the name of any installed OS service pack along with
581
+ // / other similar, detectable, updates.</summary>
582
+ // / <remarks>
583
+ // / <para>Windows has added significant OS updates that bump the build
584
+ // / number but do not declare themselves as service packs: e.g. the Windows
585
+ // / 10 TH2 update.</para>
586
+ // / <para>This method is used to report such updates in addition to
587
+ // / updates that declare themselves as service packs, while the ServicePack
588
+ // / method only reports declared 'official' service packs.</para>
589
+ // / </remarks>
590
+ class function ServicePackEx : string;
591
+
584
592
// / <summary>Returns the major version number of any NT platform service
585
593
// / pack.</summary>
586
594
// / <remarks>0 is returned in no service pack is installed, if the host OS
@@ -1201,6 +1209,11 @@ implementation
1201
1209
InternalCSDVersion: string = ' ' ;
1202
1210
// Internal variable recording processor architecture information
1203
1211
InternalProcessorArchitecture: Word = 0 ;
1212
+ // Internal variable recording additional update information.
1213
+ // ** This was added because Windows 10 TH2 doesn't declare itself as a
1214
+ // service pack, but is a significant update.
1215
+ // ** At present this variable is only used for Windows 10.
1216
+ InternalExtraUpdateInfo: string = ' ' ;
1204
1217
1205
1218
// Flag required when opening registry with specified access flags
1206
1219
{ $IFDEF REGACCESSFLAGS}
@@ -1211,7 +1224,7 @@ implementation
1211
1224
// Tests Windows version (major, minor, service pack major & service pack minor)
1212
1225
// against the given values using the given comparison condition and return
1213
1226
// True if the given version matches the current one or False if not
1214
- // Assumes VerifyVersionInfo API function is available
1227
+ // Assumes VerifyVersionInfo & VerSetConditionMask APIs functions are available
1215
1228
// Adapted from code from VersionHelpers.pas
1216
1229
// by Achim Kalwa <delphi@achim-kalwa.de> 2014-01-05
1217
1230
function TestWindowsVersion (wMajorVersion, wMinorVersion,
@@ -1255,8 +1268,25 @@ function TestWindowsVersion(wMajorVersion, wMinorVersion,
1255
1268
);
1256
1269
end ;
1257
1270
1271
+ // Checks if given build number matches that of the current OS.
1272
+ // Assumes VerifyVersionInfo & VerSetConditionMask APIs functions are available
1273
+ function IsBuildNumber (BuildNumber: DWORD): Boolean;
1274
+ var
1275
+ OSVI: TOSVersionInfoEx;
1276
+ POSVI: POSVersionInfoEx;
1277
+ ConditionalMask: UInt64;
1278
+ begin
1279
+ Assert(Assigned(VerSetConditionMask) and Assigned(VerifyVersionInfo));
1280
+ FillChar(OSVI, SizeOf(OSVI), 0 );
1281
+ OSVI.dwOSVersionInfoSize := SizeOf(OSVI);
1282
+ OSVI.dwBuildNumber := BuildNumber;
1283
+ POSVI := @OSVI;
1284
+ ConditionalMask := VerSetConditionMask(0 , VER_BUILDNUMBER, VER_EQUAL);
1285
+ Result := VerifyVersionInfo(POSVI, VER_BUILDNUMBER, ConditionalMask);
1286
+ end ;
1287
+
1258
1288
// Checks if the OS has the given product type.
1259
- // Assumes VerifyVersionInfo and VerSetConditionMask API functions are available
1289
+ // Assumes VerifyVersionInfo & VerSetConditionMask APIs functions are available
1260
1290
function IsWindowsProductType (ProductType: Byte): Boolean;
1261
1291
var
1262
1292
ConditionalMask: UInt64;
@@ -1445,23 +1475,6 @@ function GetCurrentVersionRegStr(ValName: string): string;
1445
1475
Result := GetRegistryString(HKEY_LOCAL_MACHINE, cWdwCurrentVer, ValName);
1446
1476
end ;
1447
1477
1448
- // Reads build number from registry for NT OSs only.
1449
- function GetNTBuildNumberFromReg : LongWord;
1450
- var
1451
- BuildStr: string;
1452
- begin
1453
- BuildStr := GetRegistryString(
1454
- HKEY_LOCAL_MACHINE, CurrentVersionRegKeys[True], ' CurrentBuildNumber'
1455
- );
1456
- Result := StrToIntDef(BuildStr, 0 );
1457
- if Result <> 0 then
1458
- Exit;
1459
- BuildStr := GetRegistryString(
1460
- HKEY_LOCAL_MACHINE, CurrentVersionRegKeys[True], ' CurrentBuild'
1461
- );
1462
- Result := StrToIntDef(BuildStr, 0 );
1463
- end ;
1464
-
1465
1478
// Initialise global variables with extended OS version information if possible.
1466
1479
procedure InitPlatformIdEx ;
1467
1480
@@ -1477,6 +1490,18 @@ procedure InitPlatformIdEx;
1477
1490
GetVersionEx: TGetVersionEx; // pointer to GetVersionEx API function
1478
1491
GetProductInfo: TGetProductInfo; // pointer to GetProductInfo API function
1479
1492
SI: TSystemInfo; // structure from GetSystemInfo API call
1493
+ const
1494
+ // Known windows build numbers.
1495
+ // Source: https://en.wikipedia.org/wiki/Windows_NT
1496
+ // for Vista and Win 7 we have to add service pack number to these values to
1497
+ // get actual build number
1498
+ WinVistaBaseBuild = 6000 ;
1499
+ Win7BaseBuild = 7600 ;
1500
+ // for Win 8 onwards we just use the build numbers as is
1501
+ Win8Build = 9200 ;
1502
+ Win8Point1Build = 9600 ;
1503
+ Win10TH1Build = 10240 ;
1504
+ Win10TH2Build = 10586 ;
1480
1505
begin
1481
1506
// Load version query functions used externally to this routine
1482
1507
VerSetConditionMask := LoadKernelFunc(' VerSetConditionMask' );
@@ -1505,49 +1530,68 @@ procedure InitPlatformIdEx;
1505
1530
InternalMajorVersion, InternalMinorVersion,
1506
1531
Win32ServicePackMajor, Win32ServicePackMinor
1507
1532
);
1508
- if Win32ServicePackMajor > 0 then
1509
- // tried to read this info from registry, but for some weird reason the
1510
- // required value is reported as not existant by TRegistry, even though it
1511
- // is present in registry
1512
- InternalCSDVersion := Format(' Service Pack %d' , [Win32ServicePackMajor]);
1513
1533
// NOTE: It's going to be very slow to test for all possible build numbers,
1514
- // so I've just hard wired them using the information at
1534
+ // so I've just narrowed the search down using the information at
1515
1535
// http://en.wikipedia.org/wiki/Windows_NT
1516
1536
case InternalMajorVersion of
1517
1537
6 :
1518
1538
begin
1519
1539
case InternalMinorVersion of
1520
- { $IFDEF DEBUG_NEW_API}
1521
1540
0 :
1522
- InternalBuildNumber := 6000 + Win32ServicePackMajor; // Vista
1541
+ // Vista
1542
+ InternalBuildNumber := WinVistaBaseBuild + Win32ServicePackMajor;
1523
1543
1 :
1524
- InternalBuildNumber := 7600 + Win32ServicePackMajor; // Windows 7
1544
+ // Windows 7
1545
+ InternalBuildNumber := Win7BaseBuild + Win32ServicePackMajor;
1525
1546
2 :
1547
+ // Windows 8 (no known SPs)
1526
1548
if Win32ServicePackMajor = 0 then
1527
- InternalBuildNumber := 9200 ; // Windows 8 (no known SPs)
1528
- { $ENDIF}
1549
+ InternalBuildNumber := Win8Build;
1529
1550
3 :
1551
+ // Windows 8.1 (no known SPs)
1530
1552
if Win32ServicePackMajor = 0 then
1531
- InternalBuildNumber := 9600 ; // Windows 8.1 (no known SPs)
1553
+ InternalBuildNumber := Win8Point1Build;
1532
1554
1533
1555
end ;
1556
+ if Win32ServicePackMajor > 0 then
1557
+ // ** Tried to read this info from registry, but for some weird
1558
+ // reason the required value is reported as non-existant by
1559
+ // TRegistry, even though it is present in registry.
1560
+ // ** Seems there is some kind of regitry "spoofing" going on (see
1561
+ // below.
1562
+ InternalCSDVersion := Format(
1563
+ ' Service Pack %d' , [Win32ServicePackMajor]
1564
+ );
1534
1565
end ;
1535
1566
10 :
1536
1567
begin
1537
1568
case InternalMinorVersion of
1538
1569
0 :
1539
1570
begin
1540
1571
// TODO: Revist when server version released to check if same build
1541
- // number
1542
- if Win32ServicePackMajor = 0 then
1543
- InternalBuildNumber := 10240 ; // Windows 10 (no known SPs)
1572
+ // number(s)
1573
+ // Windows 10 TH1 branch release
1574
+ if IsBuildNumber(Win10TH1Build) then
1575
+ InternalBuildNumber := Win10TH1Build
1576
+ // Windows 10 TH2 branch release
1577
+ else if IsBuildNumber(Win10TH2Build) then
1578
+ begin
1579
+ InternalBuildNumber := Win10TH2Build;
1580
+ InternalExtraUpdateInfo := ' TH2: November Update' ;
1581
+ end ;
1544
1582
end ;
1545
1583
end ;
1546
1584
end ;
1547
1585
end ;
1548
- // Failed to "guess" at build number: get it from registry
1549
- if InternalBuildNumber = 0 then
1550
- InternalBuildNumber := GetNTBuildNumberFromReg;
1586
+
1587
+ // ** If InternalBuildNumber is 0 when we get here then we failed to get it
1588
+ // We no longer look in registry as of SVN commit r2001, because this is
1589
+ // can get spoofed. E.g. when running on Windows 10 TH2 registry call is
1590
+ // returning build number of 7600 even though regedit reveals it to be
1591
+ // 10586 !
1592
+ // So we must now consider a build number of 0 as indicating an unknown
1593
+ // build number.
1594
+ // ** Seems like more registry spoofing (see above).
1551
1595
1552
1596
// Test possible product types to see which one we have
1553
1597
if IsWindowsProductType(VER_NT_WORKSTATION) then
@@ -2327,6 +2371,15 @@ class function TPJOSInfo.ServicePack: string;
2327
2371
end ;
2328
2372
end ;
2329
2373
2374
+ class function TPJOSInfo.ServicePackEx : string;
2375
+ begin
2376
+ Result := ServicePack;
2377
+ if Result = ' ' then
2378
+ Result := InternalExtraUpdateInfo
2379
+ else
2380
+ Result := Result + ' , ' + InternalExtraUpdateInfo;
2381
+ end ;
2382
+
2330
2383
class function TPJOSInfo.ServicePackMajor : Integer;
2331
2384
begin
2332
2385
Result := Win32ServicePackMajor;
0 commit comments