From cda6b346e334d2bf9beb0696a96db116dc0e9119 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 3 Oct 2024 10:41:43 +0100 Subject: [PATCH 01/17] Update PRODUCT_xxx const list & descriptions Numerous new PRODUCT_xxx constants were added as defined in the Windows 24H2 SDK. Very few descriptions could be found in MS docs for the newly added PRODUCT_xxx constants, so there is no longer a one-one mapping between the PRODUCT_xxx constants and the content of the cProductMap array of descriptions. Fixes #10 --- PJSysInfo.pas | 303 +++++++++++++++++++++++++++++++++----------------- 1 file changed, 202 insertions(+), 101 deletions(-) diff --git a/PJSysInfo.pas b/PJSysInfo.pas index 9aa09c2..d81bc3a 100644 --- a/PJSysInfo.pas +++ b/PJSysInfo.pas @@ -234,107 +234,190 @@ interface // These Windows-defined constants are required for use with the // GetProductInfo API call used with Windows Vista and later + // NOTE: PRODUCT_xxx constants marked with an asterisk comment have no + // associated description hard wired into this unit. // ** Thanks to Laurent Pierre for providing these definitions originally. // ** Subsequent additions were obtained from https://tinyurl.com/3rhhbs2z - PRODUCT_BUSINESS = $00000006; - PRODUCT_BUSINESS_N = $00000010; - PRODUCT_CLUSTER_SERVER = $00000012; - PRODUCT_CLUSTER_SERVER_V = $00000040; - PRODUCT_CORE = $00000065; - PRODUCT_CORE_COUNTRYSPECIFIC = $00000063; - PRODUCT_CORE_N = $00000062; - PRODUCT_CORE_SINGLELANGUAGE = $00000064; - PRODUCT_DATACENTER_EVALUATION_SERVER = $00000050; - PRODUCT_DATACENTER_A_SERVER_CORE = $00000091; - PRODUCT_STANDARD_A_SERVER_CORE = $00000092; - PRODUCT_DATACENTER_SERVER = $00000008; - PRODUCT_DATACENTER_SERVER_CORE = $0000000C; - PRODUCT_DATACENTER_SERVER_CORE_V = $00000027; - PRODUCT_DATACENTER_SERVER_V = $00000025; - PRODUCT_EDUCATION = $00000079; - PRODUCT_EDUCATION_N = $0000007A; - PRODUCT_ENTERPRISE = $00000004; - PRODUCT_ENTERPRISE_E = $00000046; - PRODUCT_ENTERPRISE_EVALUATION = $00000048; - PRODUCT_ENTERPRISE_N = $0000001B; - PRODUCT_ENTERPRISE_N_EVALUATION = $00000054; - PRODUCT_ENTERPRISE_S = $0000007D; - PRODUCT_ENTERPRISE_S_EVALUATION = $00000081; - PRODUCT_ENTERPRISE_S_N = $0000007E; - PRODUCT_ENTERPRISE_S_N_EVALUATION = $00000082; - 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_ESSENTIALBUSINESS_SERVER_ADDL = $0000003C; - PRODUCT_ESSENTIALBUSINESS_SERVER_ADDLSVC = $0000003E; - PRODUCT_ESSENTIALBUSINESS_SERVER_MGMT = $0000003B; - PRODUCT_ESSENTIALBUSINESS_SERVER_MGMTSVC = $0000003D; - PRODUCT_HOME_BASIC = $00000002; - PRODUCT_HOME_BASIC_E = $00000043; - PRODUCT_HOME_BASIC_N = $00000005; - PRODUCT_HOME_PREMIUM = $00000003; - PRODUCT_HOME_PREMIUM_E = $00000044; - PRODUCT_HOME_PREMIUM_N = $0000001A; - PRODUCT_HOME_PREMIUM_SERVER = $00000022; - PRODUCT_HOME_SERVER = $00000013; - PRODUCT_HYPERV = $0000002A; - PRODUCT_IOTENTERPRISE = $000000BC; - PRODUCT_IOTENTERPRISE_S = $000000BF; - PRODUCT_IOTUAP = $0000007B; - PRODUCT_IOTUAPCOMMERCIAL = $00000083; - PRODUCT_MEDIUMBUSINESS_SERVER_MANAGEMENT = $0000001E; - PRODUCT_MEDIUMBUSINESS_SERVER_MESSAGING = $00000020; - PRODUCT_MEDIUMBUSINESS_SERVER_SECURITY = $0000001F; - PRODUCT_MOBILE_CORE = $00000068; - PRODUCT_MOBILE_ENTERPRISE = $00000085; - PRODUCT_MULTIPOINT_PREMIUM_SERVER = $0000004D; - PRODUCT_MULTIPOINT_STANDARD_SERVER = $0000004C; - PRODUCT_PRO_WORKSTATION = $000000A1; - PRODUCT_PRO_WORKSTATION_N = $000000A2; - PRODUCT_PROFESSIONAL = $00000030; - PRODUCT_PROFESSIONAL_E = $00000045; - PRODUCT_PROFESSIONAL_N = $00000031; - PRODUCT_PROFESSIONAL_WMC = $00000067; - PRODUCT_SB_SOLUTION_SERVER = $00000032; - PRODUCT_SB_SOLUTION_SERVER_EM = $00000036; - PRODUCT_SERVER_FOR_SB_SOLUTIONS = $00000033; - PRODUCT_SERVER_FOR_SB_SOLUTIONS_EM = $00000037; - PRODUCT_SERVER_FOR_SMALLBUSINESS = $00000018; - PRODUCT_SERVER_FOR_SMALLBUSINESS_V = $00000023; - PRODUCT_SERVER_FOUNDATION = $00000021; - PRODUCT_SMALLBUSINESS_SERVER = $00000009; - PRODUCT_SMALLBUSINESS_SERVER_PREMIUM = $00000019; - PRODUCT_SMALLBUSINESS_SERVER_PREMIUM_CORE = $0000003F; - PRODUCT_SOLUTION_EMBEDDEDSERVER = $00000038; - PRODUCT_STANDARD_EVALUATION_SERVER = $0000004F; - PRODUCT_STANDARD_SERVER = $00000007; - PRODUCT_STANDARD_SERVER_CORE = $0000000D; - PRODUCT_STANDARD_SERVER_CORE_V = $00000028; - PRODUCT_STANDARD_SERVER_V = $00000024; - PRODUCT_STANDARD_SERVER_SOLUTIONS = $00000034; - PRODUCT_STANDARD_SERVER_SOLUTIONS_CORE = $00000035; - PRODUCT_STARTER = $0000000B; - PRODUCT_STARTER_E = $00000042; - PRODUCT_STARTER_N = $0000002F; - PRODUCT_STORAGE_ENTERPRISE_SERVER = $00000017; - PRODUCT_STORAGE_ENTERPRISE_SERVER_CORE = $0000002E; - PRODUCT_STORAGE_EXPRESS_SERVER = $00000014; - PRODUCT_STORAGE_EXPRESS_SERVER_CORE = $0000002B; - PRODUCT_STORAGE_STANDARD_EVALUATION_SERVER = $00000060; - PRODUCT_STORAGE_STANDARD_SERVER = $00000015; - PRODUCT_STORAGE_STANDARD_SERVER_CORE = $0000002C; - PRODUCT_STORAGE_WORKGROUP_EVALUATION_SERVER = $0000005F; - PRODUCT_STORAGE_WORKGROUP_SERVER = $00000016; - PRODUCT_STORAGE_WORKGROUP_SERVER_CORE = $0000002D; - PRODUCT_ULTIMATE = $00000001; - PRODUCT_ULTIMATE_E = $00000047; - PRODUCT_ULTIMATE_N = $0000001C; - PRODUCT_UNDEFINED = $00000000; - PRODUCT_WEB_SERVER = $00000011; - PRODUCT_WEB_SERVER_CORE = $0000001D; - PRODUCT_UNLICENSED = $ABCDABCD; + // ** and the Windows 11 24H2 SDK + PRODUCT_UNDEFINED = $00000000; + PRODUCT_ULTIMATE = $00000001; + PRODUCT_HOME_BASIC = $00000002; + PRODUCT_HOME_PREMIUM = $00000003; + PRODUCT_ENTERPRISE = $00000004; + PRODUCT_HOME_BASIC_N = $00000005; + PRODUCT_BUSINESS = $00000006; + PRODUCT_STANDARD_SERVER = $00000007; + PRODUCT_DATACENTER_SERVER = $00000008; + PRODUCT_SMALLBUSINESS_SERVER = $00000009; + PRODUCT_ENTERPRISE_SERVER = $0000000A; + PRODUCT_STARTER = $0000000B; + PRODUCT_DATACENTER_SERVER_CORE = $0000000C; + PRODUCT_STANDARD_SERVER_CORE = $0000000D; + PRODUCT_ENTERPRISE_SERVER_CORE = $0000000E; + PRODUCT_ENTERPRISE_SERVER_IA64 = $0000000F; + PRODUCT_BUSINESS_N = $00000010; + PRODUCT_WEB_SERVER = $00000011; + PRODUCT_CLUSTER_SERVER = $00000012; + PRODUCT_HOME_SERVER = $00000013; + PRODUCT_STORAGE_EXPRESS_SERVER = $00000014; + PRODUCT_STORAGE_STANDARD_SERVER = $00000015; + PRODUCT_STORAGE_WORKGROUP_SERVER = $00000016; + PRODUCT_STORAGE_ENTERPRISE_SERVER = $00000017; + PRODUCT_SERVER_FOR_SMALLBUSINESS = $00000018; + PRODUCT_SMALLBUSINESS_SERVER_PREMIUM = $00000019; + PRODUCT_HOME_PREMIUM_N = $0000001A; + PRODUCT_ENTERPRISE_N = $0000001B; + PRODUCT_ULTIMATE_N = $0000001C; + PRODUCT_WEB_SERVER_CORE = $0000001D; + PRODUCT_MEDIUMBUSINESS_SERVER_MANAGEMENT = $0000001E; + PRODUCT_MEDIUMBUSINESS_SERVER_SECURITY = $0000001F; + PRODUCT_MEDIUMBUSINESS_SERVER_MESSAGING = $00000020; + PRODUCT_SERVER_FOUNDATION = $00000021; + PRODUCT_HOME_PREMIUM_SERVER = $00000022; + PRODUCT_SERVER_FOR_SMALLBUSINESS_V = $00000023; + PRODUCT_STANDARD_SERVER_V = $00000024; + PRODUCT_DATACENTER_SERVER_V = $00000025; + PRODUCT_ENTERPRISE_SERVER_V = $00000026; + PRODUCT_DATACENTER_SERVER_CORE_V = $00000027; + PRODUCT_STANDARD_SERVER_CORE_V = $00000028; + PRODUCT_ENTERPRISE_SERVER_CORE_V = $00000029; + PRODUCT_HYPERV = $0000002A; + PRODUCT_STORAGE_EXPRESS_SERVER_CORE = $0000002B; + PRODUCT_STORAGE_STANDARD_SERVER_CORE = $0000002C; + PRODUCT_STORAGE_WORKGROUP_SERVER_CORE = $0000002D; + PRODUCT_STORAGE_ENTERPRISE_SERVER_CORE = $0000002E; + PRODUCT_STARTER_N = $0000002F; + PRODUCT_PROFESSIONAL = $00000030; + PRODUCT_PROFESSIONAL_N = $00000031; + PRODUCT_SB_SOLUTION_SERVER = $00000032; + PRODUCT_SERVER_FOR_SB_SOLUTIONS = $00000033; + PRODUCT_STANDARD_SERVER_SOLUTIONS = $00000034; + PRODUCT_STANDARD_SERVER_SOLUTIONS_CORE = $00000035; + PRODUCT_SB_SOLUTION_SERVER_EM = $00000036; + PRODUCT_SERVER_FOR_SB_SOLUTIONS_EM = $00000037; + PRODUCT_SOLUTION_EMBEDDEDSERVER = $00000038; + PRODUCT_SOLUTION_EMBEDDEDSERVER_CORE = $00000039; // * + PRODUCT_PROFESSIONAL_EMBEDDED = $0000003A; // * + PRODUCT_ESSENTIALBUSINESS_SERVER_MGMT = $0000003B; + PRODUCT_ESSENTIALBUSINESS_SERVER_ADDL = $0000003C; + PRODUCT_ESSENTIALBUSINESS_SERVER_MGMTSVC = $0000003D; + PRODUCT_ESSENTIALBUSINESS_SERVER_ADDLSVC = $0000003E; + PRODUCT_SMALLBUSINESS_SERVER_PREMIUM_CORE = $0000003F; + PRODUCT_CLUSTER_SERVER_V = $00000040; + PRODUCT_EMBEDDED = $00000041; // * + PRODUCT_STARTER_E = $00000042; + PRODUCT_HOME_BASIC_E = $00000043; + PRODUCT_HOME_PREMIUM_E = $00000044; + PRODUCT_PROFESSIONAL_E = $00000045; + PRODUCT_ENTERPRISE_E = $00000046; + PRODUCT_ULTIMATE_E = $00000047; + PRODUCT_ENTERPRISE_EVALUATION = $00000048; + PRODUCT_MULTIPOINT_STANDARD_SERVER = $0000004C; + PRODUCT_MULTIPOINT_PREMIUM_SERVER = $0000004D; + PRODUCT_STANDARD_EVALUATION_SERVER = $0000004F; + PRODUCT_DATACENTER_EVALUATION_SERVER = $00000050; + PRODUCT_ENTERPRISE_N_EVALUATION = $00000054; + PRODUCT_EMBEDDED_AUTOMOTIVE = $00000055; // * + PRODUCT_EMBEDDED_INDUSTRY_A = $00000056; // * + PRODUCT_THINPC = $00000057; // * + PRODUCT_EMBEDDED_A = $00000058; // * + PRODUCT_EMBEDDED_INDUSTRY = $00000059; // * + PRODUCT_EMBEDDED_E = $0000005A; // * + PRODUCT_EMBEDDED_INDUSTRY_E = $0000005B; // * + PRODUCT_EMBEDDED_INDUSTRY_A_E = $0000005C; // * + PRODUCT_STORAGE_WORKGROUP_EVALUATION_SERVER = $0000005F; + PRODUCT_STORAGE_STANDARD_EVALUATION_SERVER = $00000060; + PRODUCT_CORE_ARM = $00000061; + PRODUCT_CORE_N = $00000062; + PRODUCT_CORE_COUNTRYSPECIFIC = $00000063; + PRODUCT_CORE_SINGLELANGUAGE = $00000064; + PRODUCT_CORE = $00000065; + PRODUCT_PROFESSIONAL_WMC = $00000067; + PRODUCT_MOBILE_CORE = $00000068; + PRODUCT_EMBEDDED_INDUSTRY_EVAL = $00000069; // * + PRODUCT_EMBEDDED_INDUSTRY_E_EVAL = $0000006A; // * + PRODUCT_EMBEDDED_EVAL = $0000006B; // * + PRODUCT_EMBEDDED_E_EVAL = $0000006C; // * + PRODUCT_NANO_SERVER = $0000006D; // * + PRODUCT_CLOUD_STORAGE_SERVER = $0000006E; // * + PRODUCT_CORE_CONNECTED = $0000006F; // * + PRODUCT_PROFESSIONAL_STUDENT = $00000070; // * + PRODUCT_CORE_CONNECTED_N = $00000071; // * + PRODUCT_PROFESSIONAL_STUDENT_N = $00000072; // * + PRODUCT_CORE_CONNECTED_SINGLELANGUAGE = $00000073; // * + PRODUCT_CORE_CONNECTED_COUNTRYSPECIFIC = $00000074; // * + PRODUCT_CONNECTED_CAR = $00000075; // * + PRODUCT_INDUSTRY_HANDHELD = $00000076; // * + PRODUCT_PPI_PRO = $00000077; // * + PRODUCT_ARM64_SERVER = $00000078; // * + PRODUCT_EDUCATION = $00000079; + PRODUCT_EDUCATION_N = $0000007A; + PRODUCT_IOTUAP = $0000007B; + PRODUCT_CLOUD_HOST_INFRASTRUCTURE_SERVER = $0000007C; // * + PRODUCT_ENTERPRISE_S = $0000007D; + PRODUCT_ENTERPRISE_S_N = $0000007E; + PRODUCT_PROFESSIONAL_S = $0000007F; // * + PRODUCT_PROFESSIONAL_S_N = $00000080; // * + PRODUCT_ENTERPRISE_S_EVALUATION = $00000081; + PRODUCT_ENTERPRISE_S_N_EVALUATION = $00000082; + PRODUCT_IOTUAPCOMMERCIAL = $00000083; + PRODUCT_MOBILE_ENTERPRISE = $00000085; + PRODUCT_HOLOGRAPHIC = $00000087; // * + PRODUCT_HOLOGRAPHIC_BUSINESS = $00000088; // * + PRODUCT_PRO_SINGLE_LANGUAGE = $0000008A; // * + PRODUCT_PRO_CHINA = $0000008B; // * + PRODUCT_ENTERPRISE_SUBSCRIPTION = $0000008C; // * + PRODUCT_ENTERPRISE_SUBSCRIPTION_N = $0000008D; // * + PRODUCT_DATACENTER_NANO_SERVER = $0000008F; + PRODUCT_STANDARD_NANO_SERVER = $00000090; + PRODUCT_DATACENTER_A_SERVER_CORE = $00000091; + PRODUCT_STANDARD_A_SERVER_CORE = $00000092; + PRODUCT_DATACENTER_WS_SERVER_CORE = $00000093; + PRODUCT_STANDARD_WS_SERVER_CORE = $00000094; + PRODUCT_UTILITY_VM = $00000095; // * + PRODUCT_DATACENTER_EVALUATION_SERVER_CORE = $0000009F; // * + PRODUCT_STANDARD_EVALUATION_SERVER_CORE = $000000A0; // * + PRODUCT_PRO_WORKSTATION = $000000A1; + PRODUCT_PRO_WORKSTATION_N = $000000A2; + PRODUCT_PRO_FOR_EDUCATION = $000000A4; + PRODUCT_PRO_FOR_EDUCATION_N = $000000A5; // * + PRODUCT_AZURE_SERVER_CORE = $000000A8; // * + PRODUCT_AZURE_NANO_SERVER = $000000A9; // * + PRODUCT_ENTERPRISEG = $000000AB; // * + PRODUCT_ENTERPRISEGN = $000000AC; // * + PRODUCT_SERVERRDSH = $000000AF; + PRODUCT_CLOUD = $000000B2; // * + PRODUCT_CLOUDN = $000000B3; // * + PRODUCT_HUBOS = $000000B4; // * + PRODUCT_ONECOREUPDATEOS = $000000B6; // * + PRODUCT_CLOUDE = $000000B7; // * + PRODUCT_IOTOS = $000000B9; // * + PRODUCT_CLOUDEN = $000000BA; // * + PRODUCT_IOTEDGEOS = $000000BB; // * + PRODUCT_IOTENTERPRISE = $000000BC; + PRODUCT_LITE = $000000BD; // * + PRODUCT_IOTENTERPRISE_S = $000000BF; + PRODUCT_XBOX_SYSTEMOS = $000000C0; // * + PRODUCT_XBOX_GAMEOS = $000000C2; // * + PRODUCT_XBOX_ERAOS = $000000C3; // * + PRODUCT_XBOX_DURANGOHOSTOS = $000000C4; // * + PRODUCT_XBOX_SCARLETTHOSTOS = $000000C5; // * + PRODUCT_XBOX_KEYSTONE = $000000C6; // * + PRODUCT_AZURE_SERVER_CLOUDHOST = $000000C7; // * + PRODUCT_AZURE_SERVER_CLOUDMOS = $000000C8; // * + PRODUCT_CLOUDEDITIONN = $000000CA; // * + PRODUCT_CLOUDEDITION = $000000CB; // * + PRODUCT_VALIDATION = $000000CC; // * + PRODUCT_IOTENTERPRISESK = $000000CD; // * + PRODUCT_IOTENTERPRISEK = $000000CE; // * + PRODUCT_IOTENTERPRISESEVAL = $000000CF; // * + PRODUCT_AZURE_SERVER_AGENTBRIDGE = $000000D0; // * + PRODUCT_AZURE_SERVER_NANOHOST = $000000D1; // * + PRODUCT_WNC = $000000D2; // * + PRODUCT_AZURESTACKHCI_SERVER_CORE = $00000196; // * + PRODUCT_DATACENTER_SERVER_AZURE_EDITION = $00000197; + PRODUCT_DATACENTER_SERVER_CORE_AZURE_EDITION = $00000198; // * + PRODUCT_UNLICENSED = $ABCDABCD; // These constants are required for use with GetSystemMetrics to detect // certain editions. GetSystemMetrics returns non-zero when passed these flags @@ -997,10 +1080,12 @@ implementation const // Map of product codes per GetProductInfo API to product names + // Names are not available for all PRODUCT_xxx values. // ** Laurent Pierre supplied original code on which this map is based // It has been modified and extended using MSDN documentation at - // https://msdn.microsoft.com/en-us/library/ms724358 - cProductMap: array[1..99] of record + // https://msdn.microsoft.com/en-us/library/ms724358 and + // https://tinyurl.com/5684558v (learn.microsoft.com) + cProductMap: array[1..107] of record Id: Cardinal; // product ID Name: string; // product name end = ( @@ -1200,6 +1285,22 @@ implementation Name: 'Web Server (full installation)';), (Id: PRODUCT_WEB_SERVER_CORE; Name: 'Web Server (core installation)';), + (Id: PRODUCT_CORE_ARM; + Name: 'Windows RT';), + (Id: PRODUCT_DATACENTER_NANO_SERVER; + Name: 'Windows Server Datacenter Edition (Nano Server installation)';), + (Id: PRODUCT_STANDARD_NANO_SERVER; + Name: 'Windows Server Standard Edition (Nano Server installation)';), + (Id: PRODUCT_DATACENTER_WS_SERVER_CORE; + Name: 'Windows Server Datacenter Edition (Server Core installation)';), + (Id: PRODUCT_STANDARD_WS_SERVER_CORE; + Name: 'Windows Server Standard Edition (Server Core installation)';), + (Id: PRODUCT_PRO_FOR_EDUCATION; + Name: 'Windows 10 Pro Education';), + (Id: PRODUCT_SERVERRDSH; + Name: 'Windows 10 Enterprise for Virtual Desktops';), + (Id: PRODUCT_DATACENTER_SERVER_AZURE_EDITION; + Name: 'Windows Server Datacenter: Azure Edition';), (Id: Cardinal(PRODUCT_UNLICENSED); Name: 'Unlicensed product';) ); From 72def6816c8e20f47e6022c5b885a450bcb2e1ed Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 3 Oct 2024 17:32:43 +0100 Subject: [PATCH 02/17] Rename refactoring in TPJOSInfo EditionFromReg method renamed as NTEditionFromReg --- PJSysInfo.pas | 39 +++++++++++++++++++-------------------- 1 file changed, 19 insertions(+), 20 deletions(-) diff --git a/PJSysInfo.pas b/PJSysInfo.pas index d81bc3a..b5aacaa 100644 --- a/PJSysInfo.pas +++ b/PJSysInfo.pas @@ -557,9 +557,8 @@ TPJOSInfo = class(TObject) /// NT platform OS. class function CheckSuite(const Suite: Integer): Boolean; - /// Gets product edition from registry. - /// Needed to get edition for NT4 pre SP6. - class function EditionFromReg: string; + /// Gets product edition from registry for NT4 pre SP6. + class function NTEditionFromReg: string; /// Checks registry to see if NT4 Service Pack 6a is installed. /// @@ -3054,7 +3053,7 @@ class function TPJOSInfo.Edition: string; end else // NT before SP6: we read required info from registry - Result := EditionFromReg; + Result := NTEditionFromReg; end; end; end; @@ -3074,22 +3073,6 @@ class function TPJOSInfo.EditionFromProductInfo: string; end; end; -class function TPJOSInfo.EditionFromReg: string; -var - EditionCode: string; // OS product edition code stored in registry -begin - EditionCode := ProductTypeFromReg; - if CompareText(EditionCode, 'WINNT') = 0 then - Result := 'WorkStation' - else if CompareText(EditionCode, 'LANMANNT') = 0 then - Result := 'Server' - else if CompareText(EditionCode, 'SERVERNT') = 0 then - Result := 'Advanced Server'; - Result := Result + Format( - ' %d.%d', [InternalMajorVersion, InternalMinorVersion] - ); -end; - class function TPJOSInfo.HasPenExtensions: Boolean; begin Result := GetSystemMetrics(SM_PENWINDOWS) <> 0; @@ -3366,6 +3349,22 @@ class function TPJOSInfo.MinorVersion: Integer; Result := InternalMinorVersion; end; +class function TPJOSInfo.NTEditionFromReg: string; +var + EditionCode: string; // OS product edition code stored in registry +begin + EditionCode := ProductTypeFromReg; + if CompareText(EditionCode, 'WINNT') = 0 then + Result := 'WorkStation' + else if CompareText(EditionCode, 'LANMANNT') = 0 then + Result := 'Server' + else if CompareText(EditionCode, 'SERVERNT') = 0 then + Result := 'Advanced Server'; + Result := Result + Format( + ' %d.%d', [InternalMajorVersion, InternalMinorVersion] + ); +end; + class function TPJOSInfo.Platform: TPJOSPlatform; begin case InternalPlatform of From 07174ba180370b53d72eecaaceb452122344ffa4 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 3 Oct 2024 17:37:48 +0100 Subject: [PATCH 03/17] Make code to get edition name more robust Since updating `PRODUCT_xxx` consts, the `cProductMap` lookup table no longer has an edition name for every constant. For those cases an attempt is made to get the edition name from the registry. Fixes #11 --- PJSysInfo.pas | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/PJSysInfo.pas b/PJSysInfo.pas index b5aacaa..8ec1dc0 100644 --- a/PJSysInfo.pas +++ b/PJSysInfo.pas @@ -560,6 +560,9 @@ TPJOSInfo = class(TObject) /// Gets product edition from registry for NT4 pre SP6. class function NTEditionFromReg: string; + /// Gets edition ID from registry. + class function EditionIDFromReg: string; + /// Checks registry to see if NT4 Service Pack 6a is installed. /// class function IsNT4SP6a: Boolean; @@ -2949,7 +2952,11 @@ class function TPJOSInfo.Edition: string; // For v6.0 and later we ignore the suite mask and use the new // PRODUCT_ flags from the GetProductInfo() function to determine the // edition + // 1st try to find edition name from lookup table Result := EditionFromProductInfo; + if Result = '' then + // no matching entry in lookup: get from registry + Result := EditionIDFromReg; // append 64-bit if 64 bit system if InternalProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64 then Result := Result + ' (64-bit)'; @@ -3073,6 +3080,13 @@ class function TPJOSInfo.EditionFromProductInfo: string; end; end; +class function TPJOSInfo.EditionIDFromReg: string; +begin + Result := GetRegistryString( + HKEY_LOCAL_MACHINE, CurrentVersionRegKeys[IsWinNT], 'EditionID' + ); +end; + class function TPJOSInfo.HasPenExtensions: Boolean; begin Result := GetSystemMetrics(SM_PENWINDOWS) <> 0; From 3488efe60bdfa714b420425d3cb251f99152698b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 3 Oct 2024 17:53:19 +0100 Subject: [PATCH 04/17] Add TPJOSInfo.BuildBranch class method This method returns the name of the repository branch from which the OS was released. Fixes #12 --- PJSysInfo.pas | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/PJSysInfo.pas b/PJSysInfo.pas index 8ec1dc0..74261ea 100644 --- a/PJSysInfo.pas +++ b/PJSysInfo.pas @@ -843,6 +843,12 @@ TPJOSInfo = class(TObject) /// that this value could be spoofed. /// class function RevisionNumber: Integer; + + /// Returns the repository branch from which the OS release was] + /// built. + /// Returns the empty string if no build branch information is + /// available. + class function BuildBranch: string; end; type @@ -2873,6 +2879,13 @@ procedure InitPlatformIdEx; { TPJOSInfo } +class function TPJOSInfo.BuildBranch: string; +begin + Result := GetRegistryString( + HKEY_LOCAL_MACHINE, CurrentVersionRegKeys[IsWinNT], 'BuildBranch' + ); +end; + class function TPJOSInfo.BuildNumber: Integer; begin Result := InternalBuildNumber; From 6686ed0b2bcc55c91b1eb633ec8b05cd80c693d9 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 3 Oct 2024 19:27:41 +0100 Subject: [PATCH 05/17] Update FMX demo project for compilation w/ Delphi 12 Updated various files with changes required to build FMX demo project with Delphi 12.2: Add .res files to .gitignore: Delphi 12 generates a .res file in source directory Update FMX/FMXDemo.dproj to Delphi 12.2 format Update FMX demo form to Delphi 12.2 format: updates properties to those supported by FMX in Delphi 12.2 Update Demo form uses clause re additional units required in Delphi 12.2. --- .gitignore | 2 +- Demos/FMX/FMXDemo.dproj | 1050 ++++++++++++++++++++++++++++++++++++++- Demos/FMX/FmFMXDemo.fmx | 121 +++-- Demos/FMX/FmFMXDemo.pas | 5 +- 4 files changed, 1121 insertions(+), 57 deletions(-) diff --git a/.gitignore b/.gitignore index 943f0e2..0f0596e 100644 --- a/.gitignore +++ b/.gitignore @@ -23,7 +23,7 @@ *.a *.o *.ocx -#*.res +*.res *.tlb *.obj diff --git a/Demos/FMX/FMXDemo.dproj b/Demos/FMX/FMXDemo.dproj index d3dc8c1..5836d52 100644 --- a/Demos/FMX/FMXDemo.dproj +++ b/Demos/FMX/FMXDemo.dproj @@ -1,7 +1,7 @@  {DB9989AF-DE1C-4838-AD37-C67ED13D00EF} - 14.6 + 20.2 FMX FMXDemo.dpr True @@ -9,12 +9,23 @@ Win32 3 Application + FMXDemo true - - true + + true + Base + true + + + true + Base + true + + + true Base true @@ -30,7 +41,7 @@ false - false + 0 Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace) 2057 $(BDS)\bin\default_app.manifest @@ -43,19 +54,82 @@ false false false - - + FMXDemo $(BDS)\bin\delphi_PROJECTICNS.icns - bindcompfmx;DBXSqliteDriver;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;bindcomp;inetdb;DBXInterBaseDriver;DataSnapCommon;xmlrtl;DbxCommonDriver;IndyProtocols;dbxcds;DBXMySQLDriver;bindengine;soaprtl;bindcompdbx;CustomIPTransport;dsnap;IndyIPServer;fmxase;IndyCore;IndyIPCommon;inet;fmxobj;inetdbxpress;fmxdae;dbexpress;IndyIPClient;$(DCC_UsePackage) + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + true + true + true + true + true + true + true + true + true + true + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_NotificationIcon_40x40.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_NotificationIcon_60x60.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png + $(BDS)\bin\Artwork\iOS\iPad\FM_NotificationIcon_40x40.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SettingIcon_87x87.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_180x180.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_120x120.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_167x167.png + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_NotificationIcon_40x40.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_NotificationIcon_60x60.png + $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png + $(BDS)\bin\Artwork\iOS\iPad\FM_NotificationIcon_40x40.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SettingIcon_87x87.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_180x180.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_120x120.png + $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_167x167.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2x.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImageDark_2x.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_3x.png + $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImageDark_3x.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImage_2x.png + $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageDark_2x.png + 10.0 DDabLib32;bindcompfmx;DBXSqliteDriver;vcldbx;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;TeeDB;bindcomp;inetdb;vclib;inetdbbde;DBXInterBaseDriver;Tee;DataSnapCommon;xmlrtl;svnui;ibxpress;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;MetropolisUILiveTile;vclactnband;bindengine;vcldb;soaprtl;bindcompdbx;vcldsnap;bindcompvcl;FMXTee;TeeUI;vclie;vcltouch;websnap;CustomIPTransport;vclribbon;VclSmp;dsnap;IndyIPServer;Intraweb;fmxase;vcl;IndyCore;IndyIPCommon;CloudService;CodeSiteExpressPkg;dsnapcon;FmxTeeUI;inet;fmxobj;vclx;inetdbxpress;webdsnap;svn;fmxdae;bdertl;dbexpress;adortl;IndyIPClient;$(DCC_UsePackage) 1033 + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + Debug bindcompfmx;DBXSqliteDriver;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;bindcomp;inetdb;DBXInterBaseDriver;DataSnapCommon;xmlrtl;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;vclactnband;bindengine;vcldb;soaprtl;bindcompdbx;vcldsnap;bindcompvcl;vclie;vcltouch;websnap;CustomIPTransport;VclSmp;dsnap;IndyIPServer;fmxase;vcl;IndyCore;IndyIPCommon;dsnapcon;inet;fmxobj;vclx;inetdbxpress;webdsnap;fmxdae;dbexpress;IndyIPClient;$(DCC_UsePackage) 1033 $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + Debug @@ -118,8 +192,967 @@ Microsoft Office XP Sample Automation Server Wrapper Components - + + + + true + + + + + true + + + + + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + False + False + False False True True @@ -129,4 +1162,5 @@ + diff --git a/Demos/FMX/FmFMXDemo.fmx b/Demos/FMX/FmFMXDemo.fmx index 12253b9..fe0be25 100644 --- a/Demos/FMX/FmFMXDemo.fmx +++ b/Demos/FMX/FmFMXDemo.fmx @@ -1,26 +1,20 @@ object Form1: TForm1 Left = 0 Top = 0 - BorderStyle = bsSingle Caption = 'Form1' ClientHeight = 480 ClientWidth = 640 FormFactor.Width = 1920 FormFactor.Height = 1080 - FormFactor.Devices = [dkDesktop] + FormFactor.Devices = [Desktop, iPhone, iPad] OnCreate = FormCreate - DesignerMobile = False - DesignerWidth = 0 - DesignerHeight = 0 - DesignerDeviceName = '' - DesignerOrientation = 0 + DesignerMasterStyle = 0 object Layout1: TLayout - Align = alClient - Height = 480.000000000000000000 - Width = 640.000000000000000000 + Size.Width = 640.000000000000000000 + Size.Height = 480.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 object TabControl1: TTabControl - Align = alClient - Height = 472.000000000000000000 Padding.Left = 4.000000000000000000 Padding.Top = 4.000000000000000000 Padding.Right = 4.000000000000000000 @@ -29,72 +23,105 @@ object Form1: TForm1 Margins.Top = 4.000000000000000000 Margins.Right = 4.000000000000000000 Margins.Bottom = 4.000000000000000000 + Size.Width = 632.000000000000000000 + Size.Height = 472.000000000000000000 + Size.PlatformDefault = False TabIndex = 0 TabOrder = 0 - Width = 632.000000000000000000 + TabPosition = Top OnChange = TabControl1Change + Sizes = ( + 624s + 438s + 624s + 438s + 624s + 438s + 624s + 438s) object tiComputerInfo: TTabItem - WordWrap = False - Height = 23.000000000000000000 + CustomIcon = < + item + end> + TextSettings.Trimming = None IsSelected = True - Position.X = 1.000000000000000000 + Size.Width = 111.000000000000000000 + Size.Height = 26.000000000000000000 + Size.PlatformDefault = False + StyleLookup = '' TabOrder = 0 Text = 'TPJComputerInfo' - Width = 103.000000000000000000 + ExplicitSize.cx = 50.000000000000000000 + ExplicitSize.cy = 50.000000000000000000 object StringGrid1: TStringGrid - Align = alClient - Height = 441.000000000000000000 + CanFocus = True + ClipChildren = True + Size.Width = 624.000000000000000000 + Size.Height = 441.000000000000000000 + Size.PlatformDefault = False TabOrder = 0 - Width = 624.000000000000000000 - AlternatingRowBackground = True - ReadOnly = True - RowCount = 100 RowHeight = 21.000000000000000000 - ShowHorzLines = False - ShowSelectedCell = False + Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement] + Viewport.Width = 604.000000000000000000 + Viewport.Height = 416.000000000000000000 object NameCol: TStringColumn Header = 'Method' - Height = 415.000000000000000000 + HeaderSettings.TextSettings.WordWrap = False ReadOnly = True - TabOrder = 0 - Width = 185.000000000000000000 + Size.Width = 185.000000000000000000 end object ValueCol: TStringColumn Header = 'Value' - Height = 415.000000000000000000 - Position.X = 185.000000000000000000 + HeaderSettings.TextSettings.WordWrap = False ReadOnly = True - TabOrder = 1 - Width = 400.000000000000000000 + Size.Width = 400.000000000000000000 end end end object tiSpecialFolders: TTabItem - WordWrap = False - Height = 23.000000000000000000 + CustomIcon = < + item + end> + TextSettings.Trimming = None IsSelected = False - Position.X = 104.000000000000000000 - TabOrder = 1 + Size.Width = 113.000000000000000000 + Size.Height = 26.000000000000000000 + Size.PlatformDefault = False + StyleLookup = '' + TabOrder = 0 Text = 'TPJSpecialFolders' - Width = 104.000000000000000000 + ExplicitSize.cx = 50.000000000000000000 + ExplicitSize.cy = 50.000000000000000000 end object tiOSInfo: TTabItem - WordWrap = False - Height = 23.000000000000000000 + CustomIcon = < + item + end> + TextSettings.Trimming = None IsSelected = False - Position.X = 208.000000000000000000 - TabOrder = 2 + Size.Width = 73.000000000000000000 + Size.Height = 26.000000000000000000 + Size.PlatformDefault = False + StyleLookup = '' + TabOrder = 0 Text = 'TPJOSInfo' - Width = 68.000000000000000000 + ExplicitSize.cx = 50.000000000000000000 + ExplicitSize.cy = 50.000000000000000000 end object tiWin32Globals: TTabItem - WordWrap = False - Height = 23.000000000000000000 + CustomIcon = < + item + end> + TextSettings.Trimming = None IsSelected = False - Position.X = 276.000000000000000000 - TabOrder = 3 + Size.Width = 97.000000000000000000 + Size.Height = 26.000000000000000000 + Size.PlatformDefault = False + StyleLookup = '' + TabOrder = 0 Text = 'Win32 Globals' - Width = 90.000000000000000000 + ExplicitSize.cx = 50.000000000000000000 + ExplicitSize.cy = 50.000000000000000000 end end end diff --git a/Demos/FMX/FmFMXDemo.pas b/Demos/FMX/FmFMXDemo.pas index 0ad08c1..49b311c 100644 --- a/Demos/FMX/FmFMXDemo.pas +++ b/Demos/FMX/FmFMXDemo.pas @@ -14,7 +14,10 @@ interface System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.TabControl, FMX.Ani, FMX.Layouts, FMX.Memo, - PJSysInfo, FMX.ListBox, FMX.TreeView, FMX.Grid; + FMX.ListBox, FMX.TreeView, FMX.Grid, FMX.Grid.Style, + FMX.Controls.Presentation, FMX.ScrollBox, + + PJSysInfo; type TForm1 = class(TForm) From c0614fb4cd591cc0fe0a21c3522f9d51abf7fff9 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 3 Oct 2024 19:32:35 +0100 Subject: [PATCH 06/17] Add display of TPJOSInfo.BuildBranch to demos Added line to TPJOSInfo tab of VCL & FMX to show value returned by new BuildBranch class function. --- Demos/FMX/FmFMXDemo.pas | 1 + Demos/VCL/FmDemo.pas | 1 + 2 files changed, 2 insertions(+) diff --git a/Demos/FMX/FmFMXDemo.pas b/Demos/FMX/FmFMXDemo.pas index 49b311c..78e371e 100644 --- a/Demos/FMX/FmFMXDemo.pas +++ b/Demos/FMX/FmFMXDemo.pas @@ -148,6 +148,7 @@ procedure TForm1.ShowTPJOSInfo; begin DisplayItem('BuildNumber', TPJOSInfo.BuildNumber); DisplayItem('RevisionNumber', TPJOSInfo.RevisionNumber); + DisplayItem('BuildBranch', TPJOSInfo.BuildBranch); DisplayItem('Description', TPJOSInfo.Description); DisplayItem('Edition', TPJOSInfo.Edition); if SameDateTime(TPJOSInfo.InstallationDate, 0.0) then diff --git a/Demos/VCL/FmDemo.pas b/Demos/VCL/FmDemo.pas index c193b49..264778c 100644 --- a/Demos/VCL/FmDemo.pas +++ b/Demos/VCL/FmDemo.pas @@ -171,6 +171,7 @@ procedure TDemoForm.ShowTPJOSInfo; DisplayRuling; DisplayItem('BuildNumber', TPJOSInfo.BuildNumber); DisplayItem('RevisionNumber', TPJOSInfo.RevisionNumber); + DisplayItem('BuildBranch', TPJOSInfo.BuildBranch); DisplayItem('Description', TPJOSInfo.Description); DisplayItem('Edition', TPJOSInfo.Edition); if SameDateTime(TPJOSInfo.InstallationDate, 0.0) then From 88e585f82c805c9c1ebe745ed232181f7ffd7409 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 3 Oct 2024 21:01:16 +0100 Subject: [PATCH 07/17] Add TPJOSInfo.DigitalProductID method This method retrieves the OS's digital product ID from the registry and returns it as an array of bytes. Conditionally defined TBytes for compilers that don't have it. Fixes #16 --- PJSysInfo.pas | 48 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 47 insertions(+), 1 deletion(-) diff --git a/PJSysInfo.pas b/PJSysInfo.pas index 74261ea..9c7abb8 100644 --- a/PJSysInfo.pas +++ b/PJSysInfo.pas @@ -59,6 +59,7 @@ {$UNDEF RTLNAMESPACES} // No support for RTL namespaces in unit names {$UNDEF HASUNIT64} // UInt64 type not defined {$UNDEF INLINEMETHODS} // No support for inline methods +{$UNDEF HASTBYTES} // TBytes not defined // Undefine facilities not available in earlier compilers // Note: Delphi 1 to 3 is not included since the code will not compile on these @@ -80,6 +81,9 @@ {$IF CompilerVersion >= 24.0} // Delphi XE3 and later {$LEGACYIFEND ON} // NOTE: this must come before all $IFEND directives {$IFEND} + {$IF CompilerVersion >= 18.5} // Delphi 2007 Win32 and later + {$DEFINE HASTBYTES} + {$IFEND} {$IF CompilerVersion >= 23.0} // Delphi XE2 and later {$DEFINE RTLNAMESPACES} {$IFEND} @@ -115,6 +119,11 @@ interface System.SysUtils, System.Classes, Winapi.Windows; {$ENDIF} +{$IFNDEF HASTBYTES} +// Compiler doesn't have TBytes: define it +type + TBytes = array of Byte; +{$ENDIF} type // Windows types not defined in all supported Delphi VCLs @@ -690,6 +699,9 @@ TPJOSInfo = class(TObject) /// Returns the Windows product ID of the host OS. class function ProductID: string; + /// Returns the digital product ID of the host OS. + class function DigitalProductID: TBytes; + /// Organisation to which Windows is registered, if any. class function RegisteredOrganisation: string; @@ -1075,6 +1087,7 @@ implementation sUnknownProduct = 'Unrecognised operating system product'; sBadRegType = 'Unsupported registry type'; sBadRegIntType = 'Integer value expected in registry'; + sBadRegBinType = 'Binary value expected in registry'; sBadProcHandle = 'Bad process handle'; @@ -1085,7 +1098,6 @@ implementation UInt64 = Int64; {$ENDIF} - const // Map of product codes per GetProductInfo API to product names // Names are not available for all PRODUCT_xxx values. @@ -2148,6 +2160,33 @@ function GetRegistryInt(const RootKey: HKEY; const SubKey, Name: string): end; end; +function GetRegistryBytes(const RootKey: HKEY; const SubKey, Name: string): + TBytes; +var + Reg: TRegistry; // registry access object + ValueInfo: TRegDataInfo; // info about registry value +begin + SetLength(Result, 0); + // Open registry at required root key + Reg := RegCreate; + try + Reg.RootKey := RootKey; + if RegOpenKeyReadOnly(Reg, SubKey) and Reg.ValueExists(Name) then + begin + // Check if registry value is integer + Reg.GetDataInfo(Name, ValueInfo); + if ValueInfo.RegData <> rdBinary then + raise EPJSysInfo.Create(sBadRegBinType); + SetLength(Result, ValueInfo.DataSize); + Reg.ReadBinaryData(Name, Result[0], Length(Result)); + end; + finally + // Close registry + Reg.CloseKey; + Reg.Free; + end; +end; + // Gets string info for given value from Windows current version key in // registry. function GetCurrentVersionRegStr(ValName: string): string; @@ -2951,6 +2990,13 @@ class function TPJOSInfo.Description: string; end; end; +class function TPJOSInfo.DigitalProductID: TBytes; +begin + Result := GetRegistryBytes( + HKEY_LOCAL_MACHINE, CurrentVersionRegKeys[IsWinNT], 'DigitalProductId' + ); +end; + class function TPJOSInfo.Edition: string; begin // This method is based on sample C++ code from MSDN From 687860c29aefc7e68075e162e3979b9495d0c253 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 3 Oct 2024 21:13:50 +0100 Subject: [PATCH 08/17] Add display of TPJOSInfo.DigitalProductID to demos Added line to TPJOSInfo tab of VCL & FMX to show value returned by new DigitalProductID class function. --- Demos/FMX/FmFMXDemo.pas | 14 ++++++++++++++ Demos/VCL/FmDemo.pas | 19 +++++++++++++++---- 2 files changed, 29 insertions(+), 4 deletions(-) diff --git a/Demos/FMX/FmFMXDemo.pas b/Demos/FMX/FmFMXDemo.pas index 78e371e..89a3621 100644 --- a/Demos/FMX/FmFMXDemo.pas +++ b/Demos/FMX/FmFMXDemo.pas @@ -40,6 +40,7 @@ TForm1 = class(TForm) overload; procedure DisplayItem(const Name: string; const Value: TPJOSProduct); overload; + procedure DisplayItem(const Name: string; const Value: TBytes); overload; procedure ShowContent(Tab: Integer); procedure ShowWin32Globals; procedure ShowTPJOSInfo; @@ -168,6 +169,7 @@ procedure TForm1.ShowTPJOSInfo; DisplayItem('Platform', TPJOSInfo.Platform); DisplayItem('Product', TPJOSInfo.Product); DisplayItem('ProductID', TPJOSInfo.ProductID); + DisplayItem('DigitalProductID', TPJOSInfo.DigitalProductID); DisplayItem('ProductName', TPJOSInfo.ProductName); DisplayItem('ServicePack', TPJOSInfo.ServicePack); DisplayItem('ServicePackEx', TPJOSInfo.ServicePackEx); @@ -259,4 +261,16 @@ procedure TForm1.TabControl1Change(Sender: TObject); ShowContent(TabControl1.ActiveTab.Index); end; +procedure TForm1.DisplayItem(const Name: string; const Value: TBytes); +var + B: Byte; + S: string; +begin + S := ''; + for B in Value do + S := S + IntToHex(B) + ' '; + S := Trim(S); + DisplayItem(Name, S); +end; + end. diff --git a/Demos/VCL/FmDemo.pas b/Demos/VCL/FmDemo.pas index 264778c..0bc8e89 100644 --- a/Demos/VCL/FmDemo.pas +++ b/Demos/VCL/FmDemo.pas @@ -13,7 +13,7 @@ interface uses - StdCtrls, Classes, Controls, ComCtrls, Forms, + SysUtils, StdCtrls, Classes, Controls, ComCtrls, Forms, PJSysInfo, ExtCtrls; type @@ -34,6 +34,7 @@ TDemoForm = class(TForm) overload; procedure DisplayItem(const Name: string; const Value: TPJOSProduct); overload; + procedure DisplayItem(const Name: string; const Value: TBytes); overload; procedure ShowContent(Tab: Integer); procedure ShowWin32Globals; procedure ShowTPJOSInfo; @@ -46,9 +47,6 @@ TDemoForm = class(TForm) implementation -uses - SysUtils; - {$R *.DFM} function SameDateTime(const A, B: TDateTime): Boolean; @@ -191,6 +189,7 @@ procedure TDemoForm.ShowTPJOSInfo; DisplayItem('Platform', TPJOSInfo.Platform); DisplayItem('Product', TPJOSInfo.Product); DisplayItem('ProductID', TPJOSInfo.ProductID); + DisplayItem('DigitalProductID', TPJOSInfo.DigitalProductID); DisplayItem('ProductName', TPJOSInfo.ProductName); DisplayItem('ServicePack', TPJOSInfo.ServicePack); DisplayItem('ServicePackEx', TPJOSInfo.ServicePackEx); @@ -295,5 +294,17 @@ procedure TDemoForm.TabControl1Change(Sender: TObject); ShowContent(TabControl1.TabIndex); end; +procedure TDemoForm.DisplayItem(const Name: string; const Value: TBytes); +var + B: Byte; + S: string; +begin + S := ''; + for B in Value do + S := S + IntToHex(Integer(B), 2) + ' '; + S := Trim(S); + DisplayItem(Name, S); +end; + end. From 7bc884e82193d368ca1a15189a03eb2127a44937 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 3 Oct 2024 21:45:03 +0100 Subject: [PATCH 09/17] Fix string grid resize bug in FMX demo program Fixes #14 --- Demos/FMX/FmFMXDemo.fmx | 124 +++++++++++++--- Demos/FMX/FmFMXDemo.pas | 304 +++++++++++++++++++++++----------------- 2 files changed, 279 insertions(+), 149 deletions(-) diff --git a/Demos/FMX/FmFMXDemo.fmx b/Demos/FMX/FmFMXDemo.fmx index fe0be25..3a2f775 100644 --- a/Demos/FMX/FmFMXDemo.fmx +++ b/Demos/FMX/FmFMXDemo.fmx @@ -2,19 +2,21 @@ object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' - ClientHeight = 480 - ClientWidth = 640 + ClientHeight = 508 + ClientWidth = 688 FormFactor.Width = 1920 FormFactor.Height = 1080 FormFactor.Devices = [Desktop, iPhone, iPad] OnCreate = FormCreate DesignerMasterStyle = 0 object Layout1: TLayout - Size.Width = 640.000000000000000000 - Size.Height = 480.000000000000000000 + Align = Client + Size.Width = 688.000000000000000000 + Size.Height = 508.000000000000000000 Size.PlatformDefault = False TabOrder = 0 object TabControl1: TTabControl + Align = Client Padding.Left = 4.000000000000000000 Padding.Top = 4.000000000000000000 Padding.Right = 4.000000000000000000 @@ -23,22 +25,22 @@ object Form1: TForm1 Margins.Top = 4.000000000000000000 Margins.Right = 4.000000000000000000 Margins.Bottom = 4.000000000000000000 - Size.Width = 632.000000000000000000 - Size.Height = 472.000000000000000000 + Size.Width = 680.000000000000000000 + Size.Height = 500.000000000000000000 Size.PlatformDefault = False TabIndex = 0 TabOrder = 0 TabPosition = Top OnChange = TabControl1Change Sizes = ( - 624s - 438s - 624s - 438s - 624s - 438s - 624s - 438s) + 672s + 466s + 672s + 466s + 672s + 466s + 672s + 466s) object tiComputerInfo: TTabItem CustomIcon = < item @@ -53,24 +55,26 @@ object Form1: TForm1 Text = 'TPJComputerInfo' ExplicitSize.cx = 50.000000000000000000 ExplicitSize.cy = 50.000000000000000000 - object StringGrid1: TStringGrid + object sgComputerInfo: TStringGrid + Align = Client CanFocus = True ClipChildren = True - Size.Width = 624.000000000000000000 - Size.Height = 441.000000000000000000 + Size.Width = 672.000000000000000000 + Size.Height = 466.000000000000000000 Size.PlatformDefault = False TabOrder = 0 RowHeight = 21.000000000000000000 Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement] - Viewport.Width = 604.000000000000000000 - Viewport.Height = 416.000000000000000000 - object NameCol: TStringColumn + OnResized = sgResized + Viewport.Width = 652.000000000000000000 + Viewport.Height = 441.000000000000000000 + object StringColumn1: TStringColumn Header = 'Method' HeaderSettings.TextSettings.WordWrap = False ReadOnly = True Size.Width = 185.000000000000000000 end - object ValueCol: TStringColumn + object StringColumn2: TStringColumn Header = 'Value' HeaderSettings.TextSettings.WordWrap = False ReadOnly = True @@ -92,6 +96,32 @@ object Form1: TForm1 Text = 'TPJSpecialFolders' ExplicitSize.cx = 50.000000000000000000 ExplicitSize.cy = 50.000000000000000000 + object sgSpecialFolders: TStringGrid + Align = Client + CanFocus = True + ClipChildren = True + Size.Width = 672.000000000000000000 + Size.Height = 466.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + RowHeight = 21.000000000000000000 + Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement] + OnResized = sgResized + Viewport.Width = 652.000000000000000000 + Viewport.Height = 441.000000000000000000 + object StringColumn5: TStringColumn + Header = 'Method' + HeaderSettings.TextSettings.WordWrap = False + ReadOnly = True + Size.Width = 185.000000000000000000 + end + object StringColumn6: TStringColumn + Header = 'Value' + HeaderSettings.TextSettings.WordWrap = False + ReadOnly = True + Size.Width = 400.000000000000000000 + end + end end object tiOSInfo: TTabItem CustomIcon = < @@ -107,6 +137,32 @@ object Form1: TForm1 Text = 'TPJOSInfo' ExplicitSize.cx = 50.000000000000000000 ExplicitSize.cy = 50.000000000000000000 + object sgOSInfo: TStringGrid + Align = Client + CanFocus = True + ClipChildren = True + Size.Width = 672.000000000000000000 + Size.Height = 466.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + RowHeight = 21.000000000000000000 + Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement] + OnResized = sgResized + Viewport.Width = 652.000000000000000000 + Viewport.Height = 441.000000000000000000 + object StringColumn3: TStringColumn + Header = 'Method' + HeaderSettings.TextSettings.WordWrap = False + ReadOnly = True + Size.Width = 185.000000000000000000 + end + object StringColumn4: TStringColumn + Header = 'Value' + HeaderSettings.TextSettings.WordWrap = False + ReadOnly = True + Size.Width = 400.000000000000000000 + end + end end object tiWin32Globals: TTabItem CustomIcon = < @@ -122,6 +178,32 @@ object Form1: TForm1 Text = 'Win32 Globals' ExplicitSize.cx = 50.000000000000000000 ExplicitSize.cy = 50.000000000000000000 + object sgWin32Globals: TStringGrid + Align = Client + CanFocus = True + ClipChildren = True + Size.Width = 672.000000000000000000 + Size.Height = 466.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + RowHeight = 21.000000000000000000 + Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement] + OnResized = sgResized + Viewport.Width = 652.000000000000000000 + Viewport.Height = 441.000000000000000000 + object StringColumn7: TStringColumn + Header = 'Method' + HeaderSettings.TextSettings.WordWrap = False + ReadOnly = True + Size.Width = 185.000000000000000000 + end + object StringColumn8: TStringColumn + Header = 'Value' + HeaderSettings.TextSettings.WordWrap = False + ReadOnly = True + Size.Width = 400.000000000000000000 + end + end end end end diff --git a/Demos/FMX/FmFMXDemo.pas b/Demos/FMX/FmFMXDemo.pas index 89a3621..75d58d6 100644 --- a/Demos/FMX/FmFMXDemo.pas +++ b/Demos/FMX/FmFMXDemo.pas @@ -24,23 +24,37 @@ TForm1 = class(TForm) Layout1: TLayout; TabControl1: TTabControl; tiComputerInfo: TTabItem; - StringGrid1: TStringGrid; - NameCol: TStringColumn; - ValueCol: TStringColumn; tiSpecialFolders: TTabItem; tiOSInfo: TTabItem; tiWin32Globals: TTabItem; + sgComputerInfo: TStringGrid; + StringColumn1: TStringColumn; + StringColumn2: TStringColumn; + sgOSInfo: TStringGrid; + StringColumn3: TStringColumn; + StringColumn4: TStringColumn; + sgSpecialFolders: TStringGrid; + StringColumn5: TStringColumn; + StringColumn6: TStringColumn; + sgWin32Globals: TStringGrid; + StringColumn7: TStringColumn; + StringColumn8: TStringColumn; procedure TabControl1Change(Sender: TObject); procedure FormCreate(Sender: TObject); + procedure sgResized(Sender: TObject); private - procedure DisplayItem(const Name, Value: string); overload; - procedure DisplayItem(const Name: string; const Value: Boolean); overload; - procedure DisplayItem(const Name: string; const Value: Integer); overload; - procedure DisplayItem(const Name: string; const Value: TPJOSPlatform); + procedure DisplayItem(const SG: TStringGrid; const Name, Value: string); overload; - procedure DisplayItem(const Name: string; const Value: TPJOSProduct); - overload; - procedure DisplayItem(const Name: string; const Value: TBytes); overload; + procedure DisplayItem(const SG: TStringGrid; const Name: string; + const Value: Boolean); overload; + procedure DisplayItem(const SG: TStringGrid; const Name: string; + const Value: Integer); overload; + procedure DisplayItem(const SG: TStringGrid; const Name: string; + const Value: TPJOSPlatform); overload; + procedure DisplayItem(const SG: TStringGrid; const Name: string; + const Value: TPJOSProduct); overload; + procedure DisplayItem(const SG: TStringGrid; const Name: string; + const Value: TBytes); overload; procedure ShowContent(Tab: Integer); procedure ShowWin32Globals; procedure ShowTPJOSInfo; @@ -59,35 +73,39 @@ implementation {$R *.fmx} -procedure TForm1.DisplayItem(const Name: string; const Value: Integer); +procedure TForm1.DisplayItem(const SG: TStringGrid; const Name: string; + const Value: Integer); begin - DisplayItem(Name, IntToStr(Value)); + DisplayItem(SG, Name, IntToStr(Value)); end; -procedure TForm1.DisplayItem(const Name: string; const Value: TPJOSPlatform); +procedure TForm1.DisplayItem(const SG: TStringGrid; const Name: string; + const Value: TPJOSPlatform); const cOSPlatform: array[TPJOSPlatform] of string = ( 'ospWinNT', 'ospWin9x', 'ospWin32s' ); begin - DisplayItem(Name, cOSPlatform[Value]); + DisplayItem(SG, Name, cOSPlatform[Value]); end; -procedure TForm1.DisplayItem(const Name, Value: string); +procedure TForm1.DisplayItem(const SG: TStringGrid; const Name, Value: string); begin - StringGrid1.RowCount := StringGrid1.RowCount + 1; - StringGrid1.Cells[0, Pred(StringGrid1.RowCount)] := Name; - StringGrid1.Cells[1, Pred(StringGrid1.RowCount)] := Value; + SG.RowCount := SG.RowCount + 1; + SG.Cells[0, Pred(SG.RowCount)] := Name; + SG.Cells[1, Pred(SG.RowCount)] := Value; end; -procedure TForm1.DisplayItem(const Name: string; const Value: Boolean); +procedure TForm1.DisplayItem(const SG: TStringGrid; const Name: string; + const Value: Boolean); const cBoolean: array[Boolean] of string = ('False', 'True'); begin - DisplayItem(Name, cBoolean[Value]); + DisplayItem(SG, Name, cBoolean[Value]); end; -procedure TForm1.DisplayItem(const Name: string; const Value: TPJOSProduct); +procedure TForm1.DisplayItem(const SG: TStringGrid; const Name: string; + const Value: TPJOSProduct); const cOSProduct: array[TPJOSProduct] of string = ( 'osUnknownWinNT', 'osWinNT', 'osWin2K', 'osWinXP', 'osUnknownWin9x', @@ -98,7 +116,20 @@ procedure TForm1.DisplayItem(const Name: string; const Value: TPJOSProduct); 'osWin11', 'osWinSvr2022', 'osWinServer' ); begin - DisplayItem(Name, cOSProduct[Value]); + DisplayItem(SG, Name, cOSProduct[Value]); +end; + +procedure TForm1.DisplayItem(const SG: TStringGrid; const Name: string; + const Value: TBytes); +var + B: Byte; + S: string; +begin + S := ''; + for B in Value do + S := S + IntToHex(B) + ' '; + S := Trim(S); + DisplayItem(SG, Name, S); end; procedure TForm1.FormCreate(Sender: TObject); @@ -107,9 +138,16 @@ procedure TForm1.FormCreate(Sender: TObject); ShowContent(TabControl1.TabIndex); end; +procedure TForm1.sgResized(Sender: TObject); +var + SG: TStringGrid; +begin + SG := Sender as TStringGrid; + SG.Columns[1].Width := SG.Width - SG.Columns[0].Width - 8; +end; + procedure TForm1.ShowContent(Tab: Integer); begin - StringGrid1.RowCount := 0; case Tab of 0: ShowTPJComputerInfo; 1: ShowTPJSystemFolders; @@ -127,150 +165,160 @@ procedure TForm1.ShowTPJComputerInfo; 'bmUnknown', 'bmNormal', 'bmSafeMode', 'bmSafeModeNetwork' ); begin - DisplayItem('ComputerName', TPJComputerInfo.ComputerName); - DisplayItem('UserName', TPJComputerInfo.UserName); - DisplayItem('MACAddress', TPJComputerInfo.MACAddress); - DisplayItem('ProcessorCount', Integer(TPJComputerInfo.ProcessorCount)); - DisplayItem('Processor', cProcessors[TPJComputerInfo.Processor]); - DisplayItem('ProcessorIdentifier', TPJComputerInfo.ProcessorIdentifier); - DisplayItem('ProcessorName', TPJComputerInfo.ProcessorName); - DisplayItem('Processor Speed (MHz)', TPJComputerInfo.ProcessorSpeedMHz); - DisplayItem('Is64Bit', TPJComputerInfo.Is64Bit); - DisplayItem('IsNetworkPresent?', TPJComputerInfo.IsNetworkPresent); - DisplayItem('BootMode', cBootModes[TPJComputerInfo.BootMode]); - DisplayItem('IsAdmin', TPJComputerInfo.IsAdmin); - DisplayItem('IsUACActive', TPJComputerInfo.IsUACActive); - DisplayItem('BiosVendor', TPJComputerInfo.BiosVendor); - DisplayItem('SystemManufacturer', TPJComputerInfo.SystemManufacturer); - DisplayItem('SystemProductName', TPJComputerInfo.SystemProductName); + sgComputerInfo.RowCount := 0; + DisplayItem(sgComputerInfo, 'ComputerName', + TPJComputerInfo.ComputerName); + DisplayItem(sgComputerInfo, 'UserName', + TPJComputerInfo.UserName); + DisplayItem(sgComputerInfo, 'MACAddress', + TPJComputerInfo.MACAddress); + DisplayItem(sgComputerInfo, 'ProcessorCount', + Integer(TPJComputerInfo.ProcessorCount)); + DisplayItem(sgComputerInfo, 'Processor', + cProcessors[TPJComputerInfo.Processor]); + DisplayItem(sgComputerInfo, 'ProcessorIdentifier', + TPJComputerInfo.ProcessorIdentifier); + DisplayItem(sgComputerInfo, 'ProcessorName', TPJComputerInfo.ProcessorName); + DisplayItem(sgComputerInfo, 'Processor Speed (MHz)', + TPJComputerInfo.ProcessorSpeedMHz); + DisplayItem(sgComputerInfo, 'Is64Bit', + TPJComputerInfo.Is64Bit); + DisplayItem(sgComputerInfo, 'IsNetworkPresent?', + TPJComputerInfo.IsNetworkPresent); + DisplayItem(sgComputerInfo, 'BootMode', cBootModes[TPJComputerInfo.BootMode]); + DisplayItem(sgComputerInfo, 'IsAdmin', TPJComputerInfo.IsAdmin); + DisplayItem(sgComputerInfo, 'IsUACActive', TPJComputerInfo.IsUACActive); + DisplayItem(sgComputerInfo, 'BiosVendor', TPJComputerInfo.BiosVendor); + DisplayItem(sgComputerInfo, 'SystemManufacturer', + TPJComputerInfo.SystemManufacturer); + DisplayItem(sgComputerInfo, 'SystemProductName', + TPJComputerInfo.SystemProductName); end; procedure TForm1.ShowTPJOSInfo; begin - DisplayItem('BuildNumber', TPJOSInfo.BuildNumber); - DisplayItem('RevisionNumber', TPJOSInfo.RevisionNumber); - DisplayItem('BuildBranch', TPJOSInfo.BuildBranch); - DisplayItem('Description', TPJOSInfo.Description); - DisplayItem('Edition', TPJOSInfo.Edition); + sgOSInfo.RowCount := 0; + DisplayItem(sgOSInfo, 'BuildNumber', TPJOSInfo.BuildNumber); + DisplayItem(sgOSInfo, 'RevisionNumber', TPJOSInfo.RevisionNumber); + DisplayItem(sgOSInfo, 'BuildBranch', TPJOSInfo.BuildBranch); + DisplayItem(sgOSInfo, 'Description', TPJOSInfo.Description); + DisplayItem(sgOSInfo, 'Edition', TPJOSInfo.Edition); if SameDateTime(TPJOSInfo.InstallationDate, 0.0) then - DisplayItem('InstallationDate', 'Unknown') + DisplayItem(sgOSInfo, 'InstallationDate', 'Unknown') else - DisplayItem('InstallationDate', DateTimeToStr(TPJOSInfo.InstallationDate)); - DisplayItem('IsServer', TPJOSInfo.IsServer); - DisplayItem('IsWin32s', TPJOSInfo.IsWin32s); - DisplayItem('IsWin9x', TPJOSInfo.IsWin9x); - DisplayItem('IsWinNT', TPJOSInfo.IsWinNT); - DisplayItem('IsWow64', TPJOSInfo.IsWow64); - DisplayItem('IsMediaCenter', TPJOSInfo.IsMediaCenter); - DisplayItem('IsTabletPC', TPJOSInfo.IsTabletPC); - DisplayItem('IsRemoteSession', TPJOSInfo.IsRemoteSession); - DisplayItem('MajorVersion', TPJOSInfo.MajorVersion); - DisplayItem('MinorVersion', TPJOSInfo.MinorVersion); - DisplayItem('Platform', TPJOSInfo.Platform); - DisplayItem('Product', TPJOSInfo.Product); - DisplayItem('ProductID', TPJOSInfo.ProductID); - DisplayItem('DigitalProductID', TPJOSInfo.DigitalProductID); - DisplayItem('ProductName', TPJOSInfo.ProductName); - DisplayItem('ServicePack', TPJOSInfo.ServicePack); - DisplayItem('ServicePackEx', TPJOSInfo.ServicePackEx); - DisplayItem('ServicePackMajor', TPJOSInfo.ServicePackMajor); - DisplayItem('ServicePackMinor', TPJOSInfo.ServicePackMinor); - DisplayItem('HasPenExtensions', TPJOSInfo.HasPenExtensions); - DisplayItem('RegisteredOrganisation', TPJOSInfo.RegisteredOrganisation); - DisplayItem('RegisteredOwner', TPJOSInfo.RegisteredOwner); - DisplayItem('CanSpoof', TPJOSInfo.CanSpoof); - DisplayItem('IsReallyWindows2000OrGreater', + DisplayItem(sgOSInfo, 'InstallationDate', + DateTimeToStr(TPJOSInfo.InstallationDate)); + DisplayItem(sgOSInfo, 'IsServer', TPJOSInfo.IsServer); + DisplayItem(sgOSInfo, 'IsWin32s', TPJOSInfo.IsWin32s); + DisplayItem(sgOSInfo, 'IsWin9x', TPJOSInfo.IsWin9x); + DisplayItem(sgOSInfo, 'IsWinNT', TPJOSInfo.IsWinNT); + DisplayItem(sgOSInfo, 'IsWow64', TPJOSInfo.IsWow64); + DisplayItem(sgOSInfo, 'IsMediaCenter', TPJOSInfo.IsMediaCenter); + DisplayItem(sgOSInfo, 'IsTabletPC', TPJOSInfo.IsTabletPC); + DisplayItem(sgOSInfo, 'IsRemoteSession', TPJOSInfo.IsRemoteSession); + DisplayItem(sgOSInfo, 'MajorVersion', TPJOSInfo.MajorVersion); + DisplayItem(sgOSInfo, 'MinorVersion', TPJOSInfo.MinorVersion); + DisplayItem(sgOSInfo, 'Platform', TPJOSInfo.Platform); + DisplayItem(sgOSInfo, 'Product', TPJOSInfo.Product); + DisplayItem(sgOSInfo, 'ProductID', TPJOSInfo.ProductID); + DisplayItem(sgOSInfo, 'DigitalProductID', TPJOSInfo.DigitalProductID); + DisplayItem(sgOSInfo, 'ProductName', TPJOSInfo.ProductName); + DisplayItem(sgOSInfo, 'ServicePack', TPJOSInfo.ServicePack); + DisplayItem(sgOSInfo, 'ServicePackEx', TPJOSInfo.ServicePackEx); + DisplayItem(sgOSInfo, 'ServicePackMajor', TPJOSInfo.ServicePackMajor); + DisplayItem(sgOSInfo, 'ServicePackMinor', TPJOSInfo.ServicePackMinor); + DisplayItem(sgOSInfo, 'HasPenExtensions', TPJOSInfo.HasPenExtensions); + DisplayItem(sgOSInfo, 'RegisteredOrganisation', + TPJOSInfo.RegisteredOrganisation); + DisplayItem(sgOSInfo, 'RegisteredOwner', TPJOSInfo.RegisteredOwner); + DisplayItem(sgOSInfo, 'CanSpoof', TPJOSInfo.CanSpoof); + DisplayItem(sgOSInfo, 'IsReallyWindows2000OrGreater', TPJOSInfo.IsReallyWindows2000OrGreater); - DisplayItem('IsReallyWindows2000SP1OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindows2000SP1OrGreater', TPJOSInfo.IsReallyWindows2000SP1OrGreater); - DisplayItem('IsReallyWindows2000SP2OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindows2000SP2OrGreater', TPJOSInfo.IsReallyWindows2000SP2OrGreater); - DisplayItem('IsReallyWindows2000SP3OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindows2000SP3OrGreater', TPJOSInfo.IsReallyWindows2000SP3OrGreater); - DisplayItem('IsReallyWindows2000SP4OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindows2000SP4OrGreater', TPJOSInfo.IsReallyWindows2000SP4OrGreater); - DisplayItem('IsReallyWindowsXPOrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindowsXPOrGreater', TPJOSInfo.IsReallyWindowsXPOrGreater); - DisplayItem('IsReallyWindowsXPSP1OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindowsXPSP1OrGreater', TPJOSInfo.IsReallyWindowsXPSP1OrGreater); - DisplayItem('IsReallyWindowsXPSP2OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindowsXPSP2OrGreater', TPJOSInfo.IsReallyWindowsXPSP2OrGreater); - DisplayItem('IsReallyWindowsXPSP3OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindowsXPSP3OrGreater', TPJOSInfo.IsReallyWindowsXPSP3OrGreater); - DisplayItem('IsReallyWindowsVistaOrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindowsVistaOrGreater', TPJOSInfo.IsReallyWindowsVistaOrGreater); - DisplayItem('IsReallyWindowsVistaSP1OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindowsVistaSP1OrGreater', TPJOSInfo.IsReallyWindowsVistaSP1OrGreater); - DisplayItem('IsReallyWindowsVistaSP2OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindowsVistaSP2OrGreater', TPJOSInfo.IsReallyWindowsVistaSP2OrGreater); - DisplayItem('IsReallyWindows7OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindows7OrGreater', TPJOSInfo.IsReallyWindows7OrGreater); - DisplayItem('IsReallyWindows7SP1OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindows7SP1OrGreater', TPJOSInfo.IsReallyWindows7SP1OrGreater); - DisplayItem('IsReallyWindows8OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindows8OrGreater', TPJOSInfo.IsReallyWindows8OrGreater); - DisplayItem('IsReallyWindows8Point1OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindows8Point1OrGreater', TPJOSInfo.IsReallyWindows8Point1OrGreater); - DisplayItem('IsReallyWindows10OrGreater', + DisplayItem(sgOSInfo, 'IsReallyWindows10OrGreater', TPJOSInfo.IsReallyWindows8OrGreater); - DisplayItem('IsWindowsServer', TPJOSInfo.IsWindowsServer); + DisplayItem(sgOSInfo, 'IsWindowsServer', TPJOSInfo.IsWindowsServer); end; procedure TForm1.ShowTPJSystemFolders; begin - DisplayItem('CommonFiles', TPJSystemFolders.CommonFiles); - DisplayItem('CommonFilesX86', TPJSystemFolders.CommonFilesX86); - DisplayItem('CommonFilesRedirect', TPJSystemFolders.CommonFilesRedirect); - DisplayItem('ProgramFiles', TPJSystemFolders.ProgramFiles); - DisplayItem('ProgramFilesX86', TPJSystemFolders.ProgramFilesX86); - DisplayItem('ProgramFilesRedirect', TPJSystemFolders.ProgramFilesRedirect); - DisplayItem('Windows', TPJSystemFolders.Windows); - DisplayItem('System', TPJSystemFolders.System); - DisplayItem('SystemWow64', TPJSystemFolders.SystemWow64); - DisplayItem('Temp', TPJSystemFolders.Temp); + sgSpecialFolders.RowCount := 0; + DisplayItem(sgSpecialFolders, 'CommonFiles', + TPJSystemFolders.CommonFiles); + DisplayItem(sgSpecialFolders, 'CommonFilesX86', + TPJSystemFolders.CommonFilesX86); + DisplayItem(sgSpecialFolders, 'CommonFilesRedirect', + TPJSystemFolders.CommonFilesRedirect); + DisplayItem(sgSpecialFolders, 'ProgramFiles', + TPJSystemFolders.ProgramFiles); + DisplayItem(sgSpecialFolders, 'ProgramFilesX86', + TPJSystemFolders.ProgramFilesX86); + DisplayItem(sgSpecialFolders, 'ProgramFilesRedirect', + TPJSystemFolders.ProgramFilesRedirect); + DisplayItem(sgSpecialFolders, 'Windows', TPJSystemFolders.Windows); + DisplayItem(sgSpecialFolders, 'System', TPJSystemFolders.System); + DisplayItem(sgSpecialFolders, 'SystemWow64', TPJSystemFolders.SystemWow64); + DisplayItem(sgSpecialFolders, 'Temp', TPJSystemFolders.Temp); end; procedure TForm1.ShowWin32Globals; begin - DisplayItem('Win32Platform', Win32Platform); - DisplayItem('Win32MajorVersion', Win32MajorVersion); - DisplayItem('Win32MinorVersion', Win32MinorVersion); - DisplayItem('Win32BuildNumber', Win32BuildNumber); - DisplayItem('Win32CSDVersion', Win32CSDVersion); + sgWin32Globals.RowCount := 0; + DisplayItem(sgWin32Globals, 'Win32Platform', Win32Platform); + DisplayItem(sgWin32Globals, 'Win32MajorVersion', Win32MajorVersion); + DisplayItem(sgWin32Globals, 'Win32MinorVersion', Win32MinorVersion); + DisplayItem(sgWin32Globals, 'Win32BuildNumber', Win32BuildNumber); + DisplayItem(sgWin32Globals, 'Win32CSDVersion', Win32CSDVersion); - DisplayItem('Win32PlatformEx', Win32PlatformEx); - DisplayItem('Win32MajorVersionEx', Win32MajorVersionEx); - DisplayItem('Win32MinorVersionEx', Win32MinorVersionEx); - DisplayItem('Win32CSDVersionEx', Win32CSDVersionEx); - DisplayItem('Win32BuildNumberEx', Win32BuildNumberEx); + DisplayItem(sgWin32Globals, 'Win32PlatformEx', Win32PlatformEx); + DisplayItem(sgWin32Globals, 'Win32MajorVersionEx', Win32MajorVersionEx); + DisplayItem(sgWin32Globals, 'Win32MinorVersionEx', Win32MinorVersionEx); + DisplayItem(sgWin32Globals, 'Win32CSDVersionEx', Win32CSDVersionEx); + DisplayItem(sgWin32Globals, 'Win32BuildNumberEx', Win32BuildNumberEx); - DisplayItem('Win32RevisionNumber', Win32RevisionNumber); + DisplayItem(sgWin32Globals, 'Win32RevisionNumber', Win32RevisionNumber); - DisplayItem('Win32HaveExInfo', Win32HaveExInfo); - DisplayItem('Win32ProductType', Win32ProductType); - DisplayItem('Win32ServicePackMajor', Win32ServicePackMajor); - DisplayItem('Win32ServicePackMinor', Win32ServicePackMinor); - DisplayItem('Win32SuiteMask', Win32SuiteMask); - DisplayItem('Win32HaveProductInfo', Win32HaveProductInfo); - DisplayItem('Win32ProductInfo', Integer(Win32ProductInfo)); + DisplayItem(sgWin32Globals, 'Win32HaveExInfo', Win32HaveExInfo); + DisplayItem(sgWin32Globals, 'Win32ProductType', Win32ProductType); + DisplayItem(sgWin32Globals, 'Win32ServicePackMajor', Win32ServicePackMajor); + DisplayItem(sgWin32Globals, 'Win32ServicePackMinor', Win32ServicePackMinor); + DisplayItem(sgWin32Globals, 'Win32SuiteMask', Win32SuiteMask); + DisplayItem(sgWin32Globals, 'Win32HaveProductInfo', Win32HaveProductInfo); + DisplayItem(sgWin32Globals, 'Win32ProductInfo', Integer(Win32ProductInfo)); end; procedure TForm1.TabControl1Change(Sender: TObject); begin - StringGrid1.Parent := TabControl1.ActiveTab; ShowContent(TabControl1.ActiveTab.Index); end; -procedure TForm1.DisplayItem(const Name: string; const Value: TBytes); -var - B: Byte; - S: string; -begin - S := ''; - for B in Value do - S := S + IntToHex(B) + ' '; - S := Trim(S); - DisplayItem(Name, S); -end; - end. From 18b10b88ef45664eb3b2fd13a1b30bfadc4fa869 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 4 Oct 2024 16:42:05 +0100 Subject: [PATCH 10/17] Add new Win10/11 related methods to TPJOSInfo IsWindows10VersionOrLater - checks if OS is the same or later than a given Windows 10 "version" such as 1507. IsWindows11VersionOrLater - checks if OS is the same or later than a given Windows 11 "version" such as 23H2. Windows10PlusVersion - returns an identifier that specifies the OS "version" iff it is Win 10 or 11. Windows10PlusVersionName - returns name of the OS version iff it is Win 10 or 11. Fixes #17 --- PJSysInfo.pas | 284 +++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 226 insertions(+), 58 deletions(-) diff --git a/PJSysInfo.pas b/PJSysInfo.pas index 9c7abb8..c1b6f97 100644 --- a/PJSysInfo.pas +++ b/PJSysInfo.pas @@ -546,6 +546,17 @@ interface bmSafeModeNetwork // Booted in safe node with networking ); +type + // Various Windows 10 & 11 release versions + TPJWin10PlusVersion = ( + win10plusNA, + win10plusUnknown, + win10v1507, win10v1511, win10v1607, win10v1703, win10v1709, win10v1803, + win10v1809, win10v1903, win10v1909, win10v2004, win10v20H2, win10v21H1, + win10v21H2, win10v22H2, + win11v21H2, win11v22H2, win11v23H2, win11v24H2 + ); + type /// Class of exception raised by code in this unit. EPJSysInfo = class(Exception); @@ -592,6 +603,18 @@ TPJOSInfo = class(TObject) class function IsReallyWindowsVersionOrGreater(MajorVersion, MinorVersion, ServicePackMajor: Word): Boolean; + /// Checks if the operating system is Windows 10 or later, with a + /// version identifier the same or later than the given version identifier. + /// + /// + /// WARNING: Windows 11 versions are always considered to be later + /// Windows 10 versions, even if the Windows 10 version was released after + /// the Windows 11 version. + /// AVersion must not be one of win10plusNA or + /// win10plusUnknown. + class function IsWindows10PlusVersionOrLater( + const AVersion: TPJWin10PlusVersion): Boolean; + public /// Checks if the OS can be "spoofed" by specifying a @@ -837,6 +860,46 @@ TPJOSInfo = class(TObject) class function IsReallyWindows10OrGreater: Boolean; {$IFDEF INLINEMETHODS}inline;{$ENDIF} + /// Returns an identifier representing a Windows 10 or 11 + /// version. + /// If the OS is earlier than Windows 10 then win10plusNA + /// is returned. If the OS is Windows 10 or later but is a dev, beta etc. + /// build whose version can't be detected then win10plusUnknown is + /// returned. + class function Windows10PlusVersion: TPJWin10PlusVersion; + + /// Returns the version name of a the current operating system, if + /// it is Windows 10 or later. + /// + /// NOTE: some Windows 10 and 11 versions have the same string. + /// + /// If the OS is earlier than Windows 10 then an empty string is + /// returned. If the OS is Windows 10 or later but is a dev, beta etc. + /// build whose version can't be detected then 'Unknown' is returned. + /// + /// + class function Windows10PlusVersionName: string; + + /// Checks if the operating system is Windows 10 or later, with a + /// version identifier the same or later than AVersion. + /// + /// AVersion must be a valid Windows 10 version + /// identifier, with a name that begins with win10v. + /// EPJSysInfo raised if AVersion is not a valid + /// Windows 10 version identifier. + class function IsWindows10VersionOrLater( + const AVersion: TPJWin10PlusVersion): Boolean; + + /// Checks if the operating system is Windows 11 or later, with a + /// version identifier the same or later than AVersion. + /// + /// AVersion must be a valid Windows 11 version + /// identifier, with a name that begins with win11v. + /// EPJSysInfo raised if AVersion is not a valid + /// Windows 11 version identifier. + class function IsWindows11VersionOrLater( + const AVersion: TPJWin10PlusVersion): Boolean; + /// Checks if the OS is a server version. /// /// For Windows 2000 and later the result always relates to the @@ -1341,8 +1404,11 @@ TBuildNameMap = record LoRev: Integer; HiRev: Integer; Name: string; + Version: Word; end; + TWin10PlusVersionSet = set of TPJWin10PlusVersion; + const { Known windows build numbers. @@ -1507,47 +1573,59 @@ TBuildNameMap = record 22H2 | 2025-10-14 | N/a } + // Win 10 release build numbers + Win10_1507_Build = 10240; + Win10_1511_Build = 10586; + Win10_1607_Build = 14393; + Win10_1703_Build = 15063; + Win10_1709_Build = 16299; + Win10_1803_Build = 17134; + Win10_1809_Build = 17763; + Win10_1903_Build = Win10_19XX_Shared_Build; + Win10_1909_Build = 18363; + Win10_2004_Build = 19041; + Win10_20H2_Build = 19042; + Win10_21H1_Build = 19043; // See **REF3** End of service @ rev 2364 + Win10_21H2_Build = 19044; // See **REF4** + Win10_22H2_Build = 19045; // See **REF5** + // Map of Win 10 builds from 1st release (version 1507) to version 20H2 + // Later Win 10 releases have special handling and aren't in the build map // // NOTE: The following versions that are still being maintained per the above // table have HiRev = MaxInt while the unsupported versions have HiRev set to // the final build number. Win10_BuildMap: array[0..10] of TBuildNameMap = ( - (Build: 10240; LoRev: 16484; HiRev: MaxInt; - Name: 'Version 1507'), - (Build: 10586; LoRev: 0; HiRev: 1540; - Name: 'Version 1511: November Update'), - (Build: 14393; LoRev: 0; HiRev: MaxInt; - Name: 'Version 1607: Anniversary Update'), - (Build: 15063; LoRev: 0; HiRev: 2679; - Name: 'Version 1703: Creators Update'), - (Build: 16299; LoRev: 15; HiRev: 2166; - Name: 'Version 1709: Fall Creators Update'), - (Build: 17134; LoRev: 1; HiRev: 2208; - Name: 'Version 1803: April 2018 Update'), - (Build: 17763; LoRev: 1; HiRev: MaxInt; - Name: 'Version 1809: October 2018 Update'), - (Build: Win10_19XX_Shared_Build; LoRev: 116; HiRev: 1256; - Name: 'Version 1903: May 2019 Update'), - (Build: 18363; LoRev: 327; HiRev: 2274; - Name: 'Version 1909: November 2019 Update'), - (Build: 19041; LoRev: 264; HiRev: 1415; - Name: 'Version 2004: May 2020 Update'), - (Build: 19042; LoRev: 572; HiRev: 2965; - Name: 'Version 20H2: October 2020 Update') + (Build: Win10_1507_Build; LoRev: 16484; HiRev: MaxInt; + Name: 'Version 1507'; Version: Ord(win10v1507)), + (Build: Win10_1511_Build; LoRev: 0; HiRev: 1540; + Name: 'Version 1511: November Update'; Version: Ord(win10v1511)), + (Build: Win10_1607_Build; LoRev: 0; HiRev: MaxInt; + Name: 'Version 1607: Anniversary Update'; Version: Ord(win10v1607)), + (Build: Win10_1703_Build; LoRev: 0; HiRev: 2679; + Name: 'Version 1703: Creators Update'; Version: Ord(win10v1703)), + (Build: Win10_1709_Build; LoRev: 15; HiRev: 2166; + Name: 'Version 1709: Fall Creators Update'; Version: Ord(win10v1709)), + (Build: Win10_1803_Build; LoRev: 1; HiRev: 2208; + Name: 'Version 1803: April 2018 Update'; Version: Ord(win10v1803)), + (Build: Win10_1809_Build; LoRev: 1; HiRev: MaxInt; + Name: 'Version 1809: October 2018 Update'; Version: Ord(win10v1809)), + (Build: Win10_1903_Build; LoRev: 116; HiRev: 1256; + Name: 'Version 1903: May 2019 Update'; Version: Ord(win10v1903)), + (Build: Win10_1909_Build; LoRev: 327; HiRev: 2274; + Name: 'Version 1909: November 2019 Update'; Version: Ord(win10v1909)), + (Build: Win10_2004_Build; LoRev: 264; HiRev: 1415; + Name: 'Version 2004: May 2020 Update'; Version: Ord(win10v2004)), + (Build: Win10_20H2_Build; LoRev: 572; HiRev: 2965; + Name: 'Version 20H2: October 2020 Update'; Version: Ord(win10v20H2)) ); - // Additional information is available for Win 10 builds from version 21H1, - // as follows: - - // Windows 10 version 21H1 - see **REF3** in implementation for details - Win10_21H1_Build = 19043; // ** End of service 2022-12-13, rev 2364 - - // Windows 10 version 21H2 - see **REF4** in implementation for details - Win10_21H2_Build = 19044; - - // Windows 10 version 22H2 - see **REF5** in implementation for details - Win10_22H2_Build = 19045; + // Set of Windows 10 version identifiers + Win10_Versions: TWin10PlusVersionSet = [ + win10v1507, win10v1511, win10v1607, win10v1703, win10v1709, win10v1803, + win10v1809, win10v1903, win10v1909, win10v2004, win10v20H2, win10v21H1, + win10v21H2, win10v22H2 + ]; // Windows 10 slow ring, fast ring and skip-ahead channels were all expired // well before 2022-12-31 and are not detected. (In fact there was never any @@ -1688,6 +1766,11 @@ TBuildNameMap = record Win2019_Last_Build = 18363; WinServer_Last_Build = 19042; + // Set of Windows 10 version identifiers + Win11_Versions: TWin10PlusVersionSet = [ + win11v21H2, win11v22H2, win11v23H2, win11v24H2 + ]; + { End of support information for all Windows Server versions. @@ -1718,23 +1801,29 @@ TBuildNameMap = record // Map of Windows server releases that are named straightforwardly WinServerSimpleBuildMap: array[0..12] of TBuildNameMap = ( // Windows Server 2016 - (Build: 10074; LoRev: 0; HiRev: MaxInt; Name: 'Technical Preview 2'), - (Build: 10514; LoRev: 0; HiRev: MaxInt; Name: 'Technical Preview 3'), - (Build: 10586; LoRev: 0; HiRev: MaxInt; Name: 'Technical Preview 4'), - (Build: 14300; LoRev: 0; HiRev: MaxInt; Name: 'Technical Preview 5'), - (Build: 14393; LoRev: 0; HiRev: MaxInt; Name: 'Version 1607'), - (Build: 16299; LoRev: 0; HiRev: MaxInt; Name: 'Version 1709'), - (Build: Win2016_Last_Build; LoRev: 0; HiRev: MaxInt; Name: 'Version 1803'), + (Build: 10074; LoRev: 0; HiRev: MaxInt; Name: 'Technical Preview 2'; + Version: 0), + (Build: 10514; LoRev: 0; HiRev: MaxInt; Name: 'Technical Preview 3'; + Version: 0), + (Build: 10586; LoRev: 0; HiRev: MaxInt; Name: 'Technical Preview 4'; + Version: 0), + (Build: 14300; LoRev: 0; HiRev: MaxInt; Name: 'Technical Preview 5'; + Version: 0), + (Build: 14393; LoRev: 0; HiRev: MaxInt; Name: 'Version 1607'; Version: 0), + (Build: 16299; LoRev: 0; HiRev: MaxInt; Name: 'Version 1709'; Version: 0), + (Build: Win2016_Last_Build; LoRev: 0; HiRev: MaxInt; Name: 'Version 1803'; + Version: 0), // Windows Server 2019 - (Build: 17763; LoRev: 0; HiRev: MaxInt; Name: 'Version 1809'), - (Build: 18362; LoRev: 0; HiRev: MaxInt; Name: 'Version 1903'), - (Build: Win2019_Last_Build; LoRev: 0; HiRev: MaxInt; Name: 'Version 1909'), + (Build: 17763; LoRev: 0; HiRev: MaxInt; Name: 'Version 1809'; Version: 0), + (Build: 18362; LoRev: 0; HiRev: MaxInt; Name: 'Version 1903'; Version: 0), + (Build: Win2019_Last_Build; LoRev: 0; HiRev: MaxInt; Name: 'Version 1909'; + Version: 0), // Windows Server (no year number) - (Build: 19041; LoRev: 0; HiRev: MaxInt; Name: 'Version 2004'), + (Build: 19041; LoRev: 0; HiRev: MaxInt; Name: 'Version 2004'; Version: 0), (Build: WinServer_Last_Build; LoRev: 0; HiRev: MaxInt; - Name: 'Version 20H2'), + Name: 'Version 20H2'; Version: 0), // Windows Server 2022 - (Build: 20348; LoRev: 0; HiRev: MaxInt; Name: 'Version 21H2') + (Build: 20348; LoRev: 0; HiRev: MaxInt; Name: 'Version 21H2'; Version: 0) ); // Windows server releases needing special handling @@ -1792,6 +1881,8 @@ TBuildNameMap = record // ** At present this variable is only used for Windows 10. InternalExtraUpdateInfo: string = ''; + InternalWin1011Version: TPJWin10PlusVersion = win10plusNA; + // Flag required when opening registry with specified access flags {$IFDEF REGACCESSFLAGS} const @@ -1910,7 +2001,8 @@ function FindBuildNumberFrom(const BNs: array of Integer; var FoundBN: Integer): // parameters respectively. Otherwise False is returned, FoundBN is set to 0 and // FoundExtra is set to ''. function FindBuildNameAndExtraFrom(const Infos: array of TBuildNameMap; - var FoundBN: Integer; var FoundExtra: string): Boolean; + var FoundBN: Integer; var FoundExtra: string; var FoundVersion: Word): + Boolean; var I: Integer; begin @@ -1924,6 +2016,7 @@ function FindBuildNameAndExtraFrom(const Infos: array of TBuildNameMap; begin FoundBN := Infos[I].Build; FoundExtra := Infos[I].Name; + FoundVersion := Infos[I].Version; Result := True; Break; end; @@ -2212,6 +2305,7 @@ procedure InitPlatformIdEx; GetVersionEx: TGetVersionEx; // pointer to GetVersionEx API function GetProductInfo: TGetProductInfo; // pointer to GetProductInfo API function SI: TSystemInfo; // structure from GetSystemInfo API call + VersionEx: Word; // gets extra version info (Win 10/11) // Get OS's revision number from registry. function GetOSRevisionNumber(const IsNT: Boolean): Integer; @@ -2318,15 +2412,18 @@ procedure InitPlatformIdEx; and (Win32ProductType <> VER_NT_SERVER) then begin if FindBuildNameAndExtraFrom( - Win10_BuildMap, InternalBuildNumber, InternalExtraUpdateInfo + Win10_BuildMap, InternalBuildNumber, InternalExtraUpdateInfo, + VersionEx ) then begin - // Nothing to do: required internal variables set in function call + InternalWin1011Version := + TPJWin10PlusVersion(VersionEx); end else if IsBuildNumber(Win10_21H1_Build) then begin // **REF3** InternalBuildNumber := Win10_21H1_Build; + InternalWin1011Version := win10v21H1; case InternalRevisionNumber of 985, 1023, 1052, 1055, 1081, 1082, 1083, 1110, 1151, 1165, 1202, 1237, 1266, 1288, 1320, 1348, 1387, 1415, 1466, 1469, 1503, @@ -2357,6 +2454,7 @@ procedure InitPlatformIdEx; // From 21H2 Windows 10 moves from a 6 monthly update cycle to a // yearly cycle InternalBuildNumber := Win10_21H2_Build; + InternalWin1011Version := win10v21H2; case InternalRevisionNumber of 1288, 1348, 1387, 1415, 1466, 1469, 1503, 1526, 1566, 1586, 1620, 1645, 1682, 1706, 1708, 1741, 1766, 1767, 1806, 1826, @@ -2383,6 +2481,7 @@ procedure InitPlatformIdEx; begin // **REF5** InternalBuildNumber := Win10_22H2_Build; + InternalWin1011Version := win10v22H2; case InternalBuildNumber of 2006, 2130, 2132, 2193, 2194, 2251, 2311, 2364, 2486, 2546, 2604, 2673, 2728, 2788, 2846, 2913, 2965, 3031, 3086, 3208, @@ -2415,6 +2514,7 @@ procedure InitPlatformIdEx; else if IsBuildNumber(Win11_Dev_Build) then begin InternalBuildNumber := Win11_Dev_Build; + InternalWin1011Version := win10plusUnknown; InternalExtraUpdateInfo := Format( 'Dev [Insider v10.0.%d.%d]', [InternalBuildNumber, InternalRevisionNumber] @@ -2429,6 +2529,7 @@ procedure InitPlatformIdEx; // *** Amazingly one of them, revision 194, is the 1st public // release of Win 11 -- well hidden eh?! InternalBuildNumber := Win11_21H2_Build; + InternalWin1011Version := win11v21H2; case InternalRevisionNumber of 194, 258, 282, 348, 376, 434, 438, 469, 493, 527, 556, 593, 613, 652, 675, 708, 739, 740, 778, 795, 832, 856, 918, 978, 1042, @@ -2471,6 +2572,7 @@ procedure InitPlatformIdEx; begin // **REF1** InternalBuildNumber := Win11_22H2_Build; + InternalWin1011Version := win11v22H2; case InternalRevisionNumber of 382, 521, 525, 608, 674, 675, 755, 819, 900, 963, 1105, 1194, 1265, 1344, 1413, 1485, 1555, 1635, 1702, 1778, 1848, 1926, @@ -2520,17 +2622,21 @@ procedure InitPlatformIdEx; begin // **REF10** InternalBuildNumber := Win11_23H2_Build; + InternalWin1011Version := win11v23H2; case InternalRevisionNumber of 2428, 2506, 2715, 2792, 2861, 3007, 3085, 3155, 3235 {Moment 5}, 3296, 3374, 3447, 3527, 3593, 3672, 3737, 3810, 3880, 3958, 4037, 4112, 4169, 4249 .. MaxInt: InternalExtraUpdateInfo := 'Version 23H2'; 1825, 1830, 1835, 1900, 1906, 1972: + begin // revisions 1825..1972 had version string "22H2" + InternalWin1011Version := win11v22H2; InternalExtraUpdateInfo := Format( 'Version 22H2 [Beta v10.0.%d.%d]', [InternalBuildNumber, InternalRevisionNumber] ); + end; 2048, 2050, 2115, 2129, 2191, 2199, 2262, 2265, 2271, 2338: InternalExtraUpdateInfo := Format( 'Version 23H2 [Beta v10.0.%d.%d]', @@ -2553,6 +2659,7 @@ procedure InitPlatformIdEx; begin // **REF11** InternalBuildNumber := Win11_24H2_Build; + InternalWin1011Version := win11v24H2; case InternalRevisionNumber of 1742, 1882 .. MaxInt: InternalExtraUpdateInfo := 'Version 24H2'; @@ -2584,6 +2691,7 @@ procedure InitPlatformIdEx; begin // Win11 builds in Canary, Dev & Preview channels with version // string "24H2" + InternalWin1011Version := win10plusUnknown; InternalExtraUpdateInfo := Format( 'Dev or Canary Channel Version 24H2 v10.0.%d.%d', [InternalBuildNumber, InternalRevisionNumber] @@ -2605,6 +2713,7 @@ procedure InitPlatformIdEx; ) then begin // Win11 builds in Canary channel with version string "24H2" + InternalWin1011Version := win10plusUnknown; InternalExtraUpdateInfo := Format( 'Canary Channel Version 24H2 v10.0.%d.%d', [InternalBuildNumber, InternalRevisionNumber] @@ -2614,6 +2723,7 @@ procedure InitPlatformIdEx; begin // **REF2** InternalBuildNumber := Win11_Oct22Component_BetaChannel_Build; + InternalWin1011Version := win10plusUnknown; case InternalRevisionNumber of 290, 436, 440, 450, 575, 586, 590, 598, 601: InternalExtraUpdateInfo := Format( @@ -2652,6 +2762,7 @@ procedure InitPlatformIdEx; ) then begin // Win 11 Dev & Beta channel builds with version string "22H2" + InternalWin1011Version := win10plusUnknown; InternalExtraUpdateInfo := Format( 'Dev & Beta Channels v10.0.%d.%d (22H2)', [InternalBuildNumber, InternalRevisionNumber] @@ -2661,6 +2772,7 @@ procedure InitPlatformIdEx; begin // **REF7** InternalBuildNumber := Win11_Feb23Component_BetaChannel_Build; + InternalWin1011Version := win10plusUnknown; case InternalRevisionNumber of 730, 741, 746, 870, 875, 885, 891, 1020, 1028, 1037, 1095, 1180, 1245, 1250, 1255, 1325 .. MaxInt: @@ -2679,6 +2791,7 @@ procedure InitPlatformIdEx; begin // **REF8** InternalBuildNumber := Win11_May23Component_BetaChannel_Build; + InternalWin1011Version := win10plusUnknown; case InternalRevisionNumber of 1391, 1465, 1470, 1537, 1546, 1610, 1616, 1680, 1690, 1755 .. MaxInt: @@ -2697,6 +2810,7 @@ procedure InitPlatformIdEx; begin // **REF9** InternalBuildNumber := Win11_FutureComponent_BetaChannel_Build; + InternalWin1011Version := win10plusUnknown; case InternalRevisionNumber of 2419, 2483, 2486, 2552, 2700, 2771, 2776, 2841, 2850, 2915, 2921, 3061, 3066, 3130, 3139, 3140, 3209, 3212, 3276, 3286, @@ -2718,6 +2832,7 @@ procedure InitPlatformIdEx; begin // **REF12** InternalBuildNumber := Win11_FutureComponent_DevChannel_Build; + InternalWin1011Version := win10plusUnknown; case InternalRevisionNumber of 461, 470, 670, 751, 770, 961, 1252, 1330, 1340, 1350, 1542, 1843, 1912 .. MaxInt: @@ -2743,14 +2858,14 @@ procedure InitPlatformIdEx; InternalBuildNumber, InternalExtraUpdateInfo ) then begin - // Nothing to do: required internal variables set in function call + InternalWin1011Version := win10v20H2; end else if FindWin10PreviewBuildNameAndExtraFrom( Win10_2004_Preview_Builds, '2004', InternalBuildNumber, InternalExtraUpdateInfo ) then begin - // Nothing to do: required internal variables set in function call + InternalWin1011Version := win10v2004; end else if IsBuildNumber(Win10_19XX_Shared_Build) then begin @@ -2758,57 +2873,63 @@ procedure InitPlatformIdEx; // preview of Version 1903 or 1909 InternalBuildNumber := Win10_19XX_Shared_Build; if IsInRange(InternalRevisionNumber, 0, 113) then + begin + InternalWin1011Version := win10v1903; InternalExtraUpdateInfo := Format( 'Version 1903 Preview Build %d.%d', [InternalBuildNumber, InternalRevisionNumber] ) + end else if IsInRange(InternalRevisionNumber, 10000, 10024) then + begin + InternalWin1011Version := win10v1909; InternalExtraUpdateInfo := Format( 'Version 1909 Preview Build %d.%d', [InternalBuildNumber, InternalRevisionNumber] ); + end; end else if FindWin10PreviewBuildNameAndExtraFrom( Win10_1903_Preview_Builds, '1903', InternalBuildNumber, InternalExtraUpdateInfo ) then begin - // Nothing to do: required internal variables set in function call + InternalWin1011Version := win10v1903; end else if FindWin10PreviewBuildNameAndExtraFrom( Win10_1809_Preview_Builds, '1809', InternalBuildNumber, InternalExtraUpdateInfo ) then begin - // Nothing to do: required internal variables set in function call + InternalWin1011Version := win10v1809; end else if FindWin10PreviewBuildNameAndExtraFrom( Win10_1803_Preview_Builds, '1803', InternalBuildNumber, InternalExtraUpdateInfo ) then begin - // Nothing to do: required internal variables set in function call + InternalWin1011Version := win10v1803; end else if FindWin10PreviewBuildNameAndExtraFrom( Win10_1709_Preview_Builds, '1709', InternalBuildNumber, InternalExtraUpdateInfo ) then begin - // Nothing to do: required internal variables set in function call + InternalWin1011Version := win10v1709; end else if FindWin10PreviewBuildNameAndExtraFrom( Win10_1703_Preview_Builds, '1703', InternalBuildNumber, InternalExtraUpdateInfo ) then begin - // Nothing to do: required internal variables set in function call + InternalWin1011Version := win10v1703; end else if FindWin10PreviewBuildNameAndExtraFrom( Win10_1607_Preview_Builds, '1607', InternalBuildNumber, InternalExtraUpdateInfo ) then begin - // Nothing to do: required internal variables set in function call + InternalWin1011Version := win10v1607; end end else // Win32ProductType in [VER_NT_DOMAIN_CONTROLLER, VER_NT_SERVER] @@ -2818,7 +2939,8 @@ procedure InitPlatformIdEx; if FindBuildNameAndExtraFrom( WinServerSimpleBuildMap, InternalBuildNumber, - InternalExtraUpdateInfo + InternalExtraUpdateInfo, + VersionEx // unused ) then begin // Nothing to do: required internal variables set in function call @@ -3365,6 +3487,29 @@ class function TPJOSInfo.IsWin9x: Boolean; Result := Platform = ospWin9x; end; +class function TPJOSInfo.IsWindows10PlusVersionOrLater( + const AVersion: TPJWin10PlusVersion): Boolean; +begin + Assert(not (AVersion in [win10plusNA, win10plusUnknown])); + Result := IsReallyWindows10OrGreater and (Windows10PlusVersion >= AVersion); +end; + +class function TPJOSInfo.IsWindows10VersionOrLater( + const AVersion: TPJWin10PlusVersion): Boolean; +begin + if not (AVersion in Win10_Versions) then + raise EPJSysInfo.Create('Invalid Windows 10 version: can''t compare'); + Result := IsWindows10PlusVersionOrLater(AVersion); +end; + +class function TPJOSInfo.IsWindows11VersionOrLater( + const AVersion: TPJWin10PlusVersion): Boolean; +begin + if not (AVersion in Win11_Versions) then + raise EPJSysInfo.Create('Invalid Windows 11 version: can''t compare'); + Result := IsWindows10PlusVersionOrLater(AVersion); +end; + class function TPJOSInfo.IsWindowsServer: Boolean; var OSVI: TOSVersionInfoEx; @@ -3719,6 +3864,29 @@ class function TPJOSInfo.ServicePackMinor: Integer; Result := Win32ServicePackMinor; end; +class function TPJOSInfo.Windows10PlusVersion: TPJWin10PlusVersion; +begin + Result := InternalWin1011Version; +end; + +class function TPJOSInfo.Windows10PlusVersionName: string; +const + cVersions: array[TPJWin10PlusVersion] of string = ( + // Not windows 10+ + '', + // Windows 10+ with unknown version string + 'Unknown', + // Windows 10 + '1507', '1511', '1607', '1703', '1709', + '1803', '1809', '1903', '1909', '2004', + '20H2', '21H1', '21H2', '22H2', + // Windows 11 + '21H2', '22H2', '23H2', '24H2' + ); +begin + Result := cVersions[Windows10PlusVersion]; +end; + { TPJComputerInfo } class function TPJComputerInfo.BiosVendor: string; From cf92483c4003534f21b6359af00c3e549ec130e5 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 4 Oct 2024 17:04:11 +0100 Subject: [PATCH 11/17] Update demo projects re new TPJOSInfo methods Added display lines to TPJOSInfo demo to demonstrate output of * Windows10PlusVersion * Windows10PlusVersionName * IsWindows10VersionOrLater * IsWindows11VersionOrLater Added new overloaded DisplayItem methods to both demos to display values of the TPJWin10PlusVersion enumeration. Modify displays in both VCL & FMX demos to accommodate width of largest names to be displayed: * In VCL demo changes were made to text spacing & rulings in .pas file * In FMX demo width of string grid columns were altered in .fmx file --- Demos/FMX/FmFMXDemo.fmx | 8 +++--- Demos/FMX/FmFMXDemo.pas | 28 ++++++++++++++++++ Demos/VCL/FmDemo.pas | 63 +++++++++++++++++++++++++++++++---------- 3 files changed, 80 insertions(+), 19 deletions(-) diff --git a/Demos/FMX/FmFMXDemo.fmx b/Demos/FMX/FmFMXDemo.fmx index 3a2f775..6bb0370 100644 --- a/Demos/FMX/FmFMXDemo.fmx +++ b/Demos/FMX/FmFMXDemo.fmx @@ -72,7 +72,7 @@ object Form1: TForm1 Header = 'Method' HeaderSettings.TextSettings.WordWrap = False ReadOnly = True - Size.Width = 185.000000000000000000 + Size.Width = 240.000000000000000000 end object StringColumn2: TStringColumn Header = 'Value' @@ -113,7 +113,7 @@ object Form1: TForm1 Header = 'Method' HeaderSettings.TextSettings.WordWrap = False ReadOnly = True - Size.Width = 185.000000000000000000 + Size.Width = 240.000000000000000000 end object StringColumn6: TStringColumn Header = 'Value' @@ -154,7 +154,7 @@ object Form1: TForm1 Header = 'Method' HeaderSettings.TextSettings.WordWrap = False ReadOnly = True - Size.Width = 185.000000000000000000 + Size.Width = 240.000000000000000000 end object StringColumn4: TStringColumn Header = 'Value' @@ -195,7 +195,7 @@ object Form1: TForm1 Header = 'Method' HeaderSettings.TextSettings.WordWrap = False ReadOnly = True - Size.Width = 185.000000000000000000 + Size.Width = 240.000000000000000000 end object StringColumn8: TStringColumn Header = 'Value' diff --git a/Demos/FMX/FmFMXDemo.pas b/Demos/FMX/FmFMXDemo.pas index 75d58d6..be7621c 100644 --- a/Demos/FMX/FmFMXDemo.pas +++ b/Demos/FMX/FmFMXDemo.pas @@ -55,6 +55,8 @@ TForm1 = class(TForm) const Value: TPJOSProduct); overload; procedure DisplayItem(const SG: TStringGrid; const Name: string; const Value: TBytes); overload; + procedure DisplayItem(const SG: TStringGrid; const Name: string; + const Value: TPJWin10PlusVersion); overload; procedure ShowContent(Tab: Integer); procedure ShowWin32Globals; procedure ShowTPJOSInfo; @@ -104,6 +106,20 @@ procedure TForm1.DisplayItem(const SG: TStringGrid; const Name: string; DisplayItem(SG, Name, cBoolean[Value]); end; +procedure TForm1.DisplayItem(const SG: TStringGrid; const Name: string; + const Value: TPJWin10PlusVersion); +const + cVersions: array[TPJWin10PlusVersion] of string = ( + 'win10plusNA', 'win10plusUnknown', + 'win10v1507', 'win10v1511', 'win10v1607', 'win10v1703', 'win10v1709', + 'win10v1803', 'win10v1809', 'win10v1903', 'win10v1909', 'win10v2004', + 'win10v20H2', 'win10v21H1', 'win10v21H2', 'win10v22H2', + 'win11v21H2', 'win11v22H2', 'win11v23H2', 'win11v24H2' + ); +begin + DisplayItem(SG, Name, cVersions[Value]); +end; + procedure TForm1.DisplayItem(const SG: TStringGrid; const Name: string; const Value: TPJOSProduct); const @@ -266,6 +282,18 @@ procedure TForm1.ShowTPJOSInfo; TPJOSInfo.IsReallyWindows8Point1OrGreater); DisplayItem(sgOSInfo, 'IsReallyWindows10OrGreater', TPJOSInfo.IsReallyWindows8OrGreater); + DisplayItem(sgOSInfo, 'Windows10PlusVersion', + TPJOSInfo.Windows10PlusVersion); + DisplayItem(sgOSInfo, 'Windows10PlusVersionName', + TPJOSInfo.Windows10PlusVersionName); + DisplayItem(sgOSInfo, 'IsWindows10VersionOrLater(win10v1809)', + TPJOSInfo.IsWindows10VersionOrLater(win10v1809)); + DisplayItem(sgOSInfo, 'IsWindows10VersionOrLater(win10v22H2)', + TPJOSInfo.IsWindows10VersionOrLater(win10v22H2)); + DisplayItem(sgOSInfo, 'IsWindows11VersionOrLater(win11v23H2)', + TPJOSInfo.IsWindows11VersionOrLater(win11v23H2)); + DisplayItem(sgOSInfo, 'IsWindows11VersionOrLater(win11v24H2)', + TPJOSInfo.IsWindows11VersionOrLater(win11v24H2)); DisplayItem(sgOSInfo, 'IsWindowsServer', TPJOSInfo.IsWindowsServer); end; diff --git a/Demos/VCL/FmDemo.pas b/Demos/VCL/FmDemo.pas index 0bc8e89..8f6432c 100644 --- a/Demos/VCL/FmDemo.pas +++ b/Demos/VCL/FmDemo.pas @@ -34,6 +34,8 @@ TDemoForm = class(TForm) overload; procedure DisplayItem(const Name: string; const Value: TPJOSProduct); overload; + procedure DisplayItem(const Name: string; const Value: TPJWin10PlusVersion); + overload; procedure DisplayItem(const Name: string; const Value: TBytes); overload; procedure ShowContent(Tab: Integer); procedure ShowWin32Globals; @@ -49,6 +51,9 @@ implementation {$R *.DFM} +const + Column1Width = 38; // characters + function SameDateTime(const A, B: TDateTime): Boolean; begin Result := Abs(A - B) < (1 / MSecsPerDay); @@ -63,7 +68,7 @@ procedure TDemoForm.DisplayHeading(const Title: string); procedure TDemoForm.DisplayItem(const Name, Value: string); begin - edDisplay.Lines.Add(Format('%-32s| %s', [Name, Value])); + edDisplay.Lines.Add(Format('%-*s| %s', [Column1Width, Name, Value])); end; procedure TDemoForm.DisplayItem(const Name: string; const Value: Boolean); @@ -102,14 +107,42 @@ procedure TDemoForm.DisplayItem(const Name: string; const Value: TPJOSProduct); DisplayItem(Name, cOSProduct[Value]); end; +procedure TDemoForm.DisplayItem(const Name: string; const Value: TBytes); +var + B: Byte; + S: string; +begin + S := ''; + for B in Value do + S := S + IntToHex(Integer(B), 2) + ' '; + S := Trim(S); + DisplayItem(Name, S); +end; + +procedure TDemoForm.DisplayItem(const Name: string; + const Value: TPJWin10PlusVersion); +const + cVersions: array[TPJWin10PlusVersion] of string = ( + 'win10plusNA', 'win10plusUnknown', + 'win10v1507', 'win10v1511', 'win10v1607', 'win10v1703', 'win10v1709', + 'win10v1803', 'win10v1809', 'win10v1903', 'win10v1909', 'win10v2004', + 'win10v20H2', 'win10v21H1', 'win10v21H2', 'win10v22H2', + 'win11v21H2', 'win11v22H2', 'win11v23H2', 'win11v24H2' + ); +begin + DisplayItem(Name, cVersions[Value]); +end; + procedure TDemoForm.DisplayRuleOff; begin - edDisplay.Lines.Add(StringOfChar('=', 32) + '+' + StringOfChar('=', 55)); + edDisplay.Lines.Add(StringOfChar('=', Column1Width) + '+' + + StringOfChar('=', 55)); end; procedure TDemoForm.DisplayRuling; begin - edDisplay.Lines.Add(StringOfChar('-', 32) + '+' + StringOfChar('-', 55)); + edDisplay.Lines.Add(StringOfChar('-', Column1Width) + '+' + + StringOfChar('-', 55)); end; procedure TDemoForm.FormCreate(Sender: TObject); @@ -234,6 +267,18 @@ procedure TDemoForm.ShowTPJOSInfo; TPJOSInfo.IsReallyWindows8Point1OrGreater); DisplayItem('IsReallyWindows10OrGreater', TPJOSInfo.IsReallyWindows10OrGreater); + DisplayItem('Windows10PlusVersion', + TPJOSInfo.Windows10PlusVersion); + DisplayItem('Windows10PlusVersionName', + TPJOSInfo.Windows10PlusVersionName); + DisplayItem('IsWindows10VersionOrLater(win10v1809)', + TPJOSInfo.IsWindows10VersionOrLater(win10v1809)); + DisplayItem('IsWindows10VersionOrLater(win10v22H2)', + TPJOSInfo.IsWindows10VersionOrLater(win10v22H2)); + DisplayItem('IsWindows11VersionOrLater(win11v23H2)', + TPJOSInfo.IsWindows11VersionOrLater(win11v23H2)); + DisplayItem('IsWindows11VersionOrLater(win11v24H2)', + TPJOSInfo.IsWindows11VersionOrLater(win11v24H2)); DisplayItem('IsWindowsServer', TPJOSInfo.IsWindowsServer); DisplayRuleOff; end; @@ -294,17 +339,5 @@ procedure TDemoForm.TabControl1Change(Sender: TObject); ShowContent(TabControl1.TabIndex); end; -procedure TDemoForm.DisplayItem(const Name: string; const Value: TBytes); -var - B: Byte; - S: string; -begin - S := ''; - for B in Value do - S := S + IntToHex(Integer(B), 2) + ' '; - S := Trim(S); - DisplayItem(Name, S); -end; - end. From 594caaefbbe1b071e4c1051dbd84fd7ceee92b0d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 4 Oct 2024 19:15:10 +0100 Subject: [PATCH 12/17] Inline some TPJOSInfo methods The methods are: * CheckSuite * IsMediaCenter * IsTabletPC * IsRemoteSession * HasPenExtensions --- PJSysInfo.pas | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/PJSysInfo.pas b/PJSysInfo.pas index c1b6f97..21615b2 100644 --- a/PJSysInfo.pas +++ b/PJSysInfo.pas @@ -576,6 +576,7 @@ TPJOSInfo = class(TObject) /// True if suite is installed, False if not installed or not an /// NT platform OS. class function CheckSuite(const Suite: Integer): Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// Gets product edition from registry for NT4 pre SP6. class function NTEditionFromReg: string; @@ -651,17 +652,21 @@ TPJOSInfo = class(TObject) /// Checks if Windows Media Center is installed. class function IsMediaCenter: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// Checks if the program is running on a tablet PC OS. class function IsTabletPC: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// Checks if the program is running under Windows Terminal Server /// as a client session. class function IsRemoteSession: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// Checks of the host operating system has pen extensions /// installed. class function HasPenExtensions: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// Returns the host OS platform identifier. class function Platform: TPJOSPlatform; From 7e1a0fea15f7fe75752544e119f73879b594afaf Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 4 Oct 2024 19:16:57 +0100 Subject: [PATCH 13/17] Inline TPJComputerInfo.IsNetworkPresent --- PJSysInfo.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/PJSysInfo.pas b/PJSysInfo.pas index 21615b2..8b8d97e 100644 --- a/PJSysInfo.pas +++ b/PJSysInfo.pas @@ -981,6 +981,7 @@ TPJComputerInfo = class(TObject) /// Checks if a network is present on host computer. class function IsNetworkPresent: Boolean; + {$IFDEF INLINEMETHODS}inline;{$ENDIF} /// Returns the OS mode used when host computer was last booted. /// From fecf7f78d4fb25a7e063794337f23b52b7f713c5 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 4 Oct 2024 19:18:25 +0100 Subject: [PATCH 14/17] Add Windows unit reference to demo form .pas files Added Windows unit to VCL/FmDemo.pas and Winapi.Windows to FMX/FmFMXDemo.pas to ensure newly inlined methods of PJSysInfo.pas are actually inlined. --- Demos/FMX/FmFMXDemo.pas | 1 + Demos/VCL/FmDemo.pas | 5 +++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/Demos/FMX/FmFMXDemo.pas b/Demos/FMX/FmFMXDemo.pas index be7621c..cc01c48 100644 --- a/Demos/FMX/FmFMXDemo.pas +++ b/Demos/FMX/FmFMXDemo.pas @@ -70,6 +70,7 @@ TForm1 = class(TForm) implementation uses + Winapi.Windows, // for inlining System.DateUtils; diff --git a/Demos/VCL/FmDemo.pas b/Demos/VCL/FmDemo.pas index 8f6432c..28eedf7 100644 --- a/Demos/VCL/FmDemo.pas +++ b/Demos/VCL/FmDemo.pas @@ -13,8 +13,9 @@ interface uses - SysUtils, StdCtrls, Classes, Controls, ComCtrls, Forms, - PJSysInfo, ExtCtrls; + SysUtils, StdCtrls, Classes, Controls, ComCtrls, Forms, ExtCtrls, + Windows, {for inlining} + PJSysInfo; type TDemoForm = class(TForm) From 6ab26ce68ce0ae6c3b04c8c4b664eee369ef8fd1 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 4 Oct 2024 19:58:28 +0100 Subject: [PATCH 15/17] Remove commented out code --- PJSysInfo.pas | 31 ------------------------------- 1 file changed, 31 deletions(-) diff --git a/PJSysInfo.pas b/PJSysInfo.pas index 8b8d97e..4615738 100644 --- a/PJSysInfo.pas +++ b/PJSysInfo.pas @@ -2703,17 +2703,6 @@ procedure InitPlatformIdEx; [InternalBuildNumber, InternalRevisionNumber] ); end -// else if FindBuildNumberFrom( -// Win11PreviewCanaryChannel24H2Builds, InternalBuildNumber -// ) then -// begin -// // Win11 builds in Canary & Preview channels with version string -// // "24H2" -// InternalExtraUpdateInfo := Format( -// 'Preview or Canary Channel Version 24H2 v10.0.%d.%d', -// [InternalBuildNumber, InternalRevisionNumber] -// ); -// end else if FindBuildNumberFrom( Win11_24H2_CanaryChannel_Builds, InternalBuildNumber ) then @@ -2743,26 +2732,6 @@ procedure InitPlatformIdEx; ); end; end -// else if FindBuildNumberFrom( -// Win1122H2DevChannelDevBuilds, InternalBuildNumber -// ) then -// begin -// // Win11 Dev Channel builds with version string "22H2" -// InternalExtraUpdateInfo := Format( -// 'Dev Channel Version 22H2 v10.0.%d.%d', -// [InternalBuildNumber, InternalRevisionNumber] -// ); -// end -// else if FindBuildNumberFrom( -// Win11Canary23H2PreviewBuilds, InternalBuildNumber -// ) then -// begin -// // Win11 Canary Channel builds with version string "23H2" -// InternalExtraUpdateInfo := Format( -// 'Canary Channel Version 23H2 v10.0.%d.%d', -// [InternalBuildNumber, InternalRevisionNumber] -// ); -// end else if FindBuildNumberFrom( Win11_22H2_DevAndBetaChannel_Builds, InternalBuildNumber ) then From e6e37a6dab27260629d63f699c9d0083ed920cfb Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 4 Oct 2024 20:00:35 +0100 Subject: [PATCH 16/17] Refactor out a with statement The with statement in the TPJComputerInfo.MACAddress method was removed and replaced by fully qualified field references. --- PJSysInfo.pas | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/PJSysInfo.pas b/PJSysInfo.pas index 4615738..342fd77 100644 --- a/PJSysInfo.pas +++ b/PJSysInfo.pas @@ -4047,18 +4047,17 @@ class function TPJComputerInfo.MACAddress: string; if NetBiosSucceeded(Netbios(@Ncb)) then begin // we have a MAC address: return it - with Adapter.Adapt do - Result := Format( - '%.2x-%.2x-%.2x-%.2x-%.2x-%.2x', - [ - Ord(adapter_address[0]), - Ord(adapter_address[1]), - Ord(adapter_address[2]), - Ord(adapter_address[3]), - Ord(adapter_address[4]), - Ord(adapter_address[5]) - ] - ); + Result := Format( + '%.2x-%.2x-%.2x-%.2x-%.2x-%.2x', + [ + Ord(Adapter.Adapt.adapter_address[0]), + Ord(Adapter.Adapt.adapter_address[1]), + Ord(Adapter.Adapt.adapter_address[2]), + Ord(Adapter.Adapt.adapter_address[3]), + Ord(Adapter.Adapt.adapter_address[4]), + Ord(Adapter.Adapt.adapter_address[5]) + ] + ); Exit; end; end; From 19473f8bdc4049e4d1eaa08b38e1b18a147d1dfe Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 6 Oct 2024 15:25:17 +0100 Subject: [PATCH 17/17] Update change log with details of release v5.30.0 --- CHANGELOG.md | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7e9e01f..0c852c5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,21 @@ # Change Log for System Information Unit +## v5.30.0 of 06 October 2024 + ++ Updated PRODUCT_xxx constant definitions to include all those defined in the Windows 11 24H2 SDK. ++ Made the code in TPJOSInfo that gets the operating system edition name more robust. If the name can't be found in lookup tables then the registry is now checked too. ++ Added new TPJOSInfo.BuildBranch method that returns the name of the repository branch from which the OS was released. ++ Added new TPJOSInfo.DigitalProductID method that retrieves the OS's digital product ID. ++ Added new methods to TPJOSInfo that get additional information about the Windows 10 & 11 "version" numbers (e.g. 1507 or 23H2). The methods are IsWindows10VersionOrLater, IsWindows11VersionOrLater, Windows10PlusVersion and Windows10PlusVersionName. ++ Some TPJOSInfo and TPJComputerInfo methods were inlined. ++ Refactored out a "with" statement. ++ Removed commented out code from the PJSysInfo unit. ++ Updated the demo projects: + + The FMX demo project was modified for compilation with Delphi 12 by updating the demo project options. main form properties and required units. (All changes were automatically created by the Delphi 12 IDE.) + + Both the VCL and FMX projects were updated to demonstrate all the new TPJSysInfo methods added in this release. + + Fixed a bug in the FMX demo program where string grids were not resizing with the main window. ++ Updated `.gitignore` to ignore the `.res` files generated by Delphi 12. + ## v5.29.0 of 01 October 2024 + Updated TPJOSInfo to detect various Windows 10 and 11 builds and revisions released in July to September 2024: