unit MagCommon; {$WARN UNSAFE_TYPE off} {$WARN UNSAFE_CAST off} {$WARN UNSAFE_CODE off} {$WARN SYMBOL_PLATFORM OFF} {$WARN SYMBOL_LIBRARY OFF} {$WARN SYMBOL_DEPRECATED OFF} (* Unit to with common function from Magenta Systems. This is not a visual component and may not be installed Copyright 2024 by Angus Robertson, Magenta Systems Ltd, England delphi@magsys.co.uk, http://www.magsys.co.uk/delphi/ Last updated 10th September 2024 Designed for Delphi 7 and later, tested under Windows XP to 11 supports Delphi 7 to 12. Includes functions from MagSubs1 and MagSubs4, mostly with Mag prefixed to make unique. Uses some ICS utilities instead of old MagSubs versions, like Base64. *) interface {$I include\OverbyteIcsDefs.inc} Uses {$IFDEF RTL_NAMESPACES}Winapi.Windows{$ELSE}Windows{$ENDIF}, {$IFDEF RTL_NAMESPACES}System.SysUtils{$ELSE}SysUtils{$ENDIF}, {$IFDEF Rtl_Namespaces}System.Win.Registry{$ELSE}Registry{$ENDIF}, OverbyteIcsTypes, OverbyteIcsUtils; function MagDateTimeToAStr(const DateTime: TDateTime): string; // always alpha month and numeric hh:mm:ss function MagDateToAStr(const DateTime: TDateTime): string; // always alpha month function MagFillStr (const Ch : Char; const N : Integer): string; function MagPadChLeftStr (const S : string; const Ch : Char; const Len : Integer): string; function MagInt2StrZ (L, Len: Integer): String; function MagstrBXEncrypt(const S: String; Key: Word): String; function MagstrBXDecrypt(const S: String; Key: Word): String; function MagstrBXDecryptEx(const S: String; Key: Word): String; function MagCheckUniqueInstance: Boolean ; function MagFormatLastError: string ; function MagGetOSVersion: string ; procedure MagGetOSInfo ; function MagIsWin64: boolean ; // 22 July 2011 function MagIsWow64: boolean ; // 14 Dec 2009 function MagIsTouchTablet: boolean ; // 10 March 2014 function MagGetFileVerInfo (const AppName, KeyName: string): string ; const CVKey = 'Software\Microsoft\Windows\CurrentVersion' ; CVNTKey = 'Software\Microsoft\Windows NT\CurrentVersion'; DateOnlyPacked = 'yyyymmdd' ; DateMaskPacked = 'yyyymmdd"-"hhnnss' ; DateMaskXPacked = 'yyyymmdd"-"hhnnss"-"zzz' ; TimeMaskPacked = 'hhnnss' ; ISODateMask = 'yyyy-mm-dd' ; ISODateTimeMask = 'yyyy-mm-dd"T"hh:nn:ss' ; ISODateLongTimeMask = 'yyyy-mm-dd"T"hh:nn:ss.zzz' ; ISOTimeMask = 'hh:nn:ss' ; LongTimeMask = 'hh:nn:ss:zzz' ; FullDateTimeMask = 'yyyy/mm/dd"-"hh:nn:ss' ; DateAlphaMask = 'dd-mmm-yyyy' ; ShortTimeMask = 'hh:nn' ; SDateMaskPacked = 'yymmddhhnnss' ; DateTimeAlphaMask = 'dd-mmm-yyyy hh:nn:ss' ; DateMmmMask = 'dd mmm yyyy' ; var InstanceMutexHandle: THandle = 0; OsInfo, OsInfoRaw: TOSVERSIONINFOEXW ; GetProductInfo: function (dwOSMajorVersion, dwOSMinorVersion, dwSpMajorVersion, dwSpMinorVersion: DWORD; var dwReturnedProductType: DWORD): bool; stdcall; // 10 Aug 2010 - Vista and later VerifyVersionInfoW: function (var VersionInformation: TOSVERSIONINFOEXW; // 10 March 2014 - W2K and later const dwTypeMask: DWORD; const dwlConditionMask: ULONGLONG): BOOL; stdcall; VerSetConditionMask: function (const ConditionMask : ULONGLONG; const TypeMask : DWORD; // 10 March 2014 - W2K and later const Condition : BYTE ): ULONGLONG; stdcall; type TIsWow64Process = function (hProcess: THandle; var Wow64Process: BOOL): BOOL; stdcall; // 14 Dec 2009 function GetVersionExW2 (var lpVersionInfo: TOSVERSIONINFOEXW): BOOL; stdcall; function GetVersionExW2; external kernel32 name 'GetVersionExW'; // 11 Aug 2015 - this kernel mode version provides accurate OS information without a manifest function RtlGetVersion (var lpVersionInformation: TOSVERSIONINFOEXW): DWORD; stdcall; // Windows 2000 and later function RtlGetVersion; external 'ntdll.dll' name 'RtlGetVersion'; CONST // wProductType VER_NT_WORKSTATION = $0000001 ; {$EXTERNALSYM VER_NT_WORKSTATION} VER_NT_DOMAIN_CONTROLLER = $0000002 ; {$EXTERNALSYM VER_NT_DOMAIN_CONTROLLER} VER_NT_SERVER = $0000003 ; {$EXTERNALSYM VER_NT_SERVER} // wSuiteMask VER_SERVER_NT = $80000000 ; {$EXTERNALSYM VER_SERVER_NT} VER_WORKSTATION_NT = $40000000 ; {$EXTERNALSYM VER_WORKSTATION_NT} VER_SUITE_SMALLBUSINESS = $00000001 ; {$EXTERNALSYM VER_SUITE_SMALLBUSINESS} VER_SUITE_ENTERPRISE = $00000002 ; {$EXTERNALSYM VER_SUITE_ENTERPRISE} VER_SUITE_BACKOFFICE = $00000004 ; {$EXTERNALSYM VER_SUITE_BACKOFFICE} VER_SUITE_COMMUNICATIONS = $00000008 ; {$EXTERNALSYM VER_SUITE_COMMUNICATIONS} VER_SUITE_TERMINAL = $00000010 ; {$EXTERNALSYM VER_SUITE_TERMINAL} VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020 ; {$EXTERNALSYM VER_SUITE_SMALLBUSINESS_RESTRICTED} VER_SUITE_EMBEDDEDNT = $00000040 ; {$EXTERNALSYM VER_SUITE_EMBEDDEDNT} VER_SUITE_DATACENTER = $00000080 ; {$EXTERNALSYM VER_SUITE_DATACENTER} VER_SUITE_SINGLEUSERTS = $00000100 ; {$EXTERNALSYM VER_SUITE_SINGLEUSERTS} VER_SUITE_PERSONAL = $00000200 ; {$EXTERNALSYM VER_SUITE_PERSONAL} VER_SUITE_BLADE = $00000400 ; {$EXTERNALSYM VER_SUITE_BLADE} VER_SUITE_EMBEDDED_RESTRICTED = $00000800 ; {$EXTERNALSYM VER_SUITE_EMBEDDED_RESTRICTED} VER_SUITE_SECURITY_APPLICANCE = $00001000 ; {$EXTERNALSYM VER_SUITE_SECURITY_APPLICANCE} VER_SUITE_STORAGE_SERVER = $00002000 ; {$EXTERNALSYM VER_SUITE_STORAGE_SERVER} VER_SUITE_COMPUTE_SERVER = $00004000 ; {$EXTERNALSYM VER_SUITE_COMPUTE_SERVER} VER_SUITE_WH_SERVER = $00008000 ; {$EXTERNALSYM VER_SUITE_WH_SERVER} // GetSystemMetrics - OS version subtypes SM_TABLETPC = 86 ; {$EXTERNALSYM SM_TABLETPC} SM_MEDIACENTER = 87 ; {$EXTERNALSYM SM_MEDIACENTER} SM_STARTER = 88 ; {$EXTERNALSYM SM_STARTER} SM_SERVERR2 = 89 ; {$EXTERNALSYM SM_SERVERR2} SM_MOUSEHORIZONTALWHEELPRESENT = 91 ; {$EXTERNALSYM SM_MOUSEHORIZONTALWHEELPRESENT} SM_CXPADDEDBORDER = 92 ; {$EXTERNALSYM SM_CXPADDEDBORDER} SM_DIGITIZER = 94 ; {$EXTERNALSYM SM_DIGITIZER} SM_MAXIMUMTOUCHES = 95 ; {$EXTERNALSYM SM_MAXIMUMTOUCHES} // GetProductInfo = product types - Vista and later, // 10 Aug 2010 PRODUCT_UNDEFINED = $00000000; {$EXTERNALSYM PRODUCT_UNDEFINED} PRODUCT_ULTIMATE = $00000001; {$EXTERNALSYM PRODUCT_ULTIMATE} PRODUCT_HOME_BASIC = $00000002; {$EXTERNALSYM PRODUCT_HOME_BASIC} PRODUCT_HOME_PREMIUM = $00000003; {$EXTERNALSYM PRODUCT_HOME_PREMIUM} PRODUCT_ENTERPRISE = $00000004; {$EXTERNALSYM PRODUCT_ENTERPRISE} PRODUCT_HOME_BASIC_N = $00000005; {$EXTERNALSYM PRODUCT_HOME_BASIC_N} PRODUCT_BUSINESS = $00000006; {$EXTERNALSYM PRODUCT_BUSINESS} PRODUCT_STANDARD_SERVER = $00000007; {$EXTERNALSYM PRODUCT_STANDARD_SERVER} PRODUCT_DATACENTER_SERVER = $00000008; {$EXTERNALSYM PRODUCT_DATACENTER_SERVER} PRODUCT_SMALLBUSINESS_SERVER = $00000009; {$EXTERNALSYM PRODUCT_SMALLBUSINESS_SERVER} PRODUCT_ENTERPRISE_SERVER = $0000000A; {$EXTERNALSYM PRODUCT_ENTERPRISE_SERVER} PRODUCT_STARTER = $0000000B; {$EXTERNALSYM PRODUCT_STARTER} PRODUCT_DATACENTER_SERVER_CORE = $0000000C; {$EXTERNALSYM PRODUCT_DATACENTER_SERVER_CORE} PRODUCT_STANDARD_SERVER_CORE = $0000000D; {$EXTERNALSYM PRODUCT_STANDARD_SERVER_CORE} PRODUCT_ENTERPRISE_SERVER_CORE = $0000000E; {$EXTERNALSYM PRODUCT_ENTERPRISE_SERVER_CORE} PRODUCT_ENTERPRISE_SERVER_IA64 = $0000000F; {$EXTERNALSYM PRODUCT_ENTERPRISE_SERVER_IA64} PRODUCT_BUSINESS_N = $00000010; {$EXTERNALSYM PRODUCT_BUSINESS_N} PRODUCT_WEB_SERVER = $00000011; {$EXTERNALSYM PRODUCT_WEB_SERVER} PRODUCT_CLUSTER_SERVER = $00000012; {$EXTERNALSYM PRODUCT_CLUSTER_SERVER} PRODUCT_HOME_SERVER = $00000013; {$EXTERNALSYM PRODUCT_HOME_SERVER} PRODUCT_STORAGE_EXPRESS_SERVER = $00000014; {$EXTERNALSYM PRODUCT_STORAGE_EXPRESS_SERVER} PRODUCT_STORAGE_STANDARD_SERVER = $00000015; {$EXTERNALSYM PRODUCT_STORAGE_STANDARD_SERVER} PRODUCT_STORAGE_WORKGROUP_SERVER = $00000016; {$EXTERNALSYM PRODUCT_STORAGE_WORKGROUP_SERVER} PRODUCT_STORAGE_ENTERPRISE_SERVER = $00000017; {$EXTERNALSYM PRODUCT_STORAGE_ENTERPRISE_SERVER} PRODUCT_SERVER_FOR_SMALLBUSINESS = $00000018; {$EXTERNALSYM PRODUCT_SERVER_FOR_SMALLBUSINESS} PRODUCT_SMALLBUSINESS_SERVER_PREMIUM = $00000019; {$EXTERNALSYM PRODUCT_SMALLBUSINESS_SERVER_PREMIUM} PRODUCT_HOME_PREMIUM_N = $0000001A; {$EXTERNALSYM PRODUCT_HOME_PREMIUM_N} PRODUCT_ENTERPRISE_N = $0000001B; {$EXTERNALSYM PRODUCT_ENTERPRISE_N} PRODUCT_ULTIMATE_N = $0000001C; {$EXTERNALSYM PRODUCT_ULTIMATE_N} PRODUCT_WEB_SERVER_CORE = $0000001D; {$EXTERNALSYM PRODUCT_WEB_SERVER_CORE} PRODUCT_MEDIUMBUSINESS_SERVER_MANAGEMENT = $0000001E; {$EXTERNALSYM PRODUCT_MEDIUMBUSINESS_SERVER_MANAGEMENT} PRODUCT_MEDIUMBUSINESS_SERVER_SECURITY = $0000001F; {$EXTERNALSYM PRODUCT_MEDIUMBUSINESS_SERVER_SECURITY} PRODUCT_MEDIUMBUSINESS_SERVER_MESSAGING = $00000020; {$EXTERNALSYM PRODUCT_MEDIUMBUSINESS_SERVER_MESSAGING } PRODUCT_SERVER_FOUNDATION = $00000021; {$EXTERNALSYM PRODUCT_SERVER_FOUNDATION} PRODUCT_HOME_PREMIUM_SERVER = $00000022; {$EXTERNALSYM PRODUCT_HOME_PREMIUM_SERVER} PRODUCT_SERVER_FOR_SMALLBUSINESS_V = $00000023; {$EXTERNALSYM PRODUCT_SERVER_FOR_SMALLBUSINESS_V} PRODUCT_STANDARD_SERVER_V = $00000024; {$EXTERNALSYM PRODUCT_STANDARD_SERVER_V} PRODUCT_DATACENTER_SERVER_V = $00000025; {$EXTERNALSYM PRODUCT_DATACENTER_SERVER_V} PRODUCT_ENTERPRISE_SERVER_V = $00000026; {$EXTERNALSYM PRODUCT_ENTERPRISE_SERVER_V} PRODUCT_DATACENTER_SERVER_CORE_V = $00000027; {$EXTERNALSYM PRODUCT_DATACENTER_SERVER_CORE_V} PRODUCT_STANDARD_SERVER_CORE_V = $00000028; {$EXTERNALSYM PRODUCT_STANDARD_SERVER_CORE_V} PRODUCT_ENTERPRISE_SERVER_CORE_V = $00000029; {$EXTERNALSYM PRODUCT_ENTERPRISE_SERVER_CORE_V} PRODUCT_HYPERV = $0000002A; {$EXTERNALSYM PRODUCT_HYPERV} PRODUCT_STORAGE_EXPRESS_SERVER_CORE = $0000002B; {$EXTERNALSYM PRODUCT_STORAGE_EXPRESS_SERVER_CORE} PRODUCT_STORAGE_STANDARD_SERVER_CORE = $0000002C; {$EXTERNALSYM PRODUCT_STORAGE_STANDARD_SERVER_CORE} PRODUCT_STORAGE_WORKGROUP_SERVER_CORE = $0000002D; {$EXTERNALSYM PRODUCT_STORAGE_WORKGROUP_SERVER_CORE} PRODUCT_STORAGE_ENTERPRISE_SERVER_CORE = $0000002E; {$EXTERNALSYM PRODUCT_STORAGE_ENTERPRISE_SERVER_CORE} PRODUCT_STARTER_N = $0000002F; {$EXTERNALSYM PRODUCT_STARTER_N} PRODUCT_PROFESSIONAL = $00000030; {$EXTERNALSYM PRODUCT_PROFESSIONAL} PRODUCT_PROFESSIONAL_N = $00000031; {$EXTERNALSYM PRODUCT_PROFESSIONAL_N} PRODUCT_SB_SOLUTION_SERVER = $00000032; {$EXTERNALSYM PRODUCT_SB_SOLUTION_SERVER} PRODUCT_SERVER_FOR_SB_SOLUTIONS = $00000033; {$EXTERNALSYM PRODUCT_SERVER_FOR_SB_SOLUTIONS} PRODUCT_STANDARD_SERVER_SOLUTIONS = $00000034; {$EXTERNALSYM PRODUCT_STANDARD_SERVER_SOLUTIONS} PRODUCT_STANDARD_SERVER_SOLUTIONS_CORE = $00000035; {$EXTERNALSYM PRODUCT_STANDARD_SERVER_SOLUTIONS_CORE} PRODUCT_SB_SOLUTION_SERVER_EM = $00000036; {$EXTERNALSYM PRODUCT_SB_SOLUTION_SERVER_EM} PRODUCT_SERVER_FOR_SB_SOLUTIONS_EM = $00000037; {$EXTERNALSYM PRODUCT_SERVER_FOR_SB_SOLUTIONS_EM} PRODUCT_SOLUTION_EMBEDDEDSERVER = $00000038; {$EXTERNALSYM PRODUCT_SOLUTION_EMBEDDEDSERVER} PRODUCT_SOLUTION_EMBEDDEDSERVER_CORE = $00000039; {$EXTERNALSYM PRODUCT_SOLUTION_EMBEDDEDSERVER_CORE} PRODUCT_SMALLBUSINESS_SERVER_PREMIUM_CORE = $0000003F; {$EXTERNALSYM PRODUCT_SMALLBUSINESS_SERVER_PREMIUM_CORE} PRODUCT_ESSENTIALBUSINESS_SERVER_MGMT = $0000003B; {$EXTERNALSYM PRODUCT_ESSENTIALBUSINESS_SERVER_MGMT} PRODUCT_ESSENTIALBUSINESS_SERVER_ADDL = $0000003C; {$EXTERNALSYM PRODUCT_ESSENTIALBUSINESS_SERVER_ADDL} PRODUCT_ESSENTIALBUSINESS_SERVER_MGMTSVC = $0000003D; {$EXTERNALSYM PRODUCT_ESSENTIALBUSINESS_SERVER_MGMTSVC} PRODUCT_ESSENTIALBUSINESS_SERVER_ADDLSVC = $0000003E; {$EXTERNALSYM PRODUCT_ESSENTIALBUSINESS_SERVER_ADDLSVC} PRODUCT_CLUSTER_SERVER_V = $00000040; {$EXTERNALSYM PRODUCT_CLUSTER_SERVER_V} PRODUCT_EMBEDDED = $00000041; {$EXTERNALSYM PRODUCT_EMBEDDED} PRODUCT_STARTER_E = $00000042; {$EXTERNALSYM PRODUCT_STARTER_E} PRODUCT_HOME_BASIC_E = $00000043; {$EXTERNALSYM PRODUCT_HOME_BASIC_E} PRODUCT_HOME_PREMIUM_E = $00000044; {$EXTERNALSYM PRODUCT_HOME_PREMIUM_E} PRODUCT_PROFESSIONAL_E = $00000045; {$EXTERNALSYM PRODUCT_PROFESSIONAL_E} PRODUCT_ENTERPRISE_E = $00000046; {$EXTERNALSYM PRODUCT_ENTERPRISE_E} PRODUCT_ULTIMATE_E = $00000047; {$EXTERNALSYM PRODUCT_ULTIMATE_E} PRODUCT_ENTERPRISE_EVALUATION = $00000048; // following Windows 8 SDK {$EXTERNALSYM PRODUCT_ENTERPRISE_EVALUATION} PRODUCT_MULTIPOINT_STANDARD_SERVER = $0000004C; {$EXTERNALSYM PRODUCT_MULTIPOINT_STANDARD_SERVER} PRODUCT_MULTIPOINT_PREMIUM_SERVER = $0000004D; {$EXTERNALSYM PRODUCT_MULTIPOINT_PREMIUM_SERVER} PRODUCT_STANDARD_EVALUATION_SERVER = $0000004F; {$EXTERNALSYM PRODUCT_STANDARD_EVALUATION_SERVER} PRODUCT_DATACENTER_EVALUATION_SERVER = $00000050; {$EXTERNALSYM PRODUCT_DATACENTER_EVALUATION_SERVER} PRODUCT_ENTERPRISE_N_EVALUATION = $00000054; {$EXTERNALSYM PRODUCT_ENTERPRISE_N_EVALUATION} PRODUCT_EMBEDDED_AUTOMOTIVE = $00000055; {$EXTERNALSYM PRODUCT_EMBEDDED_AUTOMOTIVE} PRODUCT_EMBEDDED_INDUSTRY_A = $00000056; {$EXTERNALSYM PRODUCT_EMBEDDED_INDUSTRY_A} PRODUCT_THINPC = $00000057; {$EXTERNALSYM PRODUCT_THINPC} PRODUCT_EMBEDDED_A = $00000058; {$EXTERNALSYM PRODUCT_EMBEDDED_A} PRODUCT_EMBEDDED_INDUSTRY = $00000059; {$EXTERNALSYM PRODUCT_EMBEDDED_INDUSTRY} PRODUCT_EMBEDDED_E = $0000005A; {$EXTERNALSYM PRODUCT_EMBEDDED_E} PRODUCT_EMBEDDED_INDUSTRY_E = $0000005B; {$EXTERNALSYM PRODUCT_EMBEDDED_INDUSTRY_E} PRODUCT_EMBEDDED_INDUSTRY_A_E = $0000005C; {$EXTERNALSYM PRODUCT_EMBEDDED_INDUSTRY_A_E} PRODUCT_STORAGE_WORKGROUP_EVALUATION_SERVER = $0000005F; {$EXTERNALSYM PRODUCT_STORAGE_WORKGROUP_EVALUATION_SERVER} PRODUCT_STORAGE_STANDARD_EVALUATION_SERVER = $00000060; {$EXTERNALSYM PRODUCT_STORAGE_STANDARD_EVALUATION_SERVER} PRODUCT_CORE_ARM = $00000061; {$EXTERNALSYM PRODUCT_CORE_ARM} PRODUCT_CORE_N = $00000062; // Windows 10 Home {$EXTERNALSYM PRODUCT_CORE_N} PRODUCT_CORE_COUNTRYSPECIFIC = $00000063; // Windows 10 Home China {$EXTERNALSYM PRODUCT_CORE_COUNTRYSPECIFIC} PRODUCT_CORE_SINGLELANGUAGE = $00000064; // Windows 10 Home Single Language {$EXTERNALSYM PRODUCT_CORE_SINGLELANGUAGE} PRODUCT_CORE = $00000065; // Windows 10 Home {$EXTERNALSYM PRODUCT_CORE} PRODUCT_PROFESSIONAL_WMC = $00000067; // Professional with Media Center {$EXTERNALSYM PRODUCT_PROFESSIONAL_WMC} // following Nov 2017 PRODUCT_MOBILE_CORE = $00000068; // Windows 10 Mobile {$EXTERNALSYM PRODUCT_MOBILE_CORE} PRODUCT_EMBEDDED_INDUSTRY_EVAL = $00000069; {$EXTERNALSYM PRODUCT_EMBEDDED_INDUSTRY_EVAL} PRODUCT_EMBEDDED_INDUSTRY_E_EVAL = $0000006A; {$EXTERNALSYM PRODUCT_EMBEDDED_INDUSTRY_E_EVAL} PRODUCT_EMBEDDED_EVAL = $0000006B; {$EXTERNALSYM PRODUCT_EMBEDDED_EVAL} PRODUCT_EMBEDDED_E_EVAL = $0000006C; {$EXTERNALSYM PRODUCT_EMBEDDED_E_EVAL} PRODUCT_NANO_SERVER = $0000006D; {$EXTERNALSYM PRODUCT_NANO_SERVER} PRODUCT_CLOUD_STORAGE_SERVER = $0000006E; {$EXTERNALSYM PRODUCT_CLOUD_STORAGE_SERVER} PRODUCT_CORE_CONNECTED = $0000006F; {$EXTERNALSYM PRODUCT_CORE_CONNECTED} PRODUCT_PROFESSIONAL_STUDENT = $00000070; {$EXTERNALSYM PRODUCT_PROFESSIONAL_STUDENT} PRODUCT_CORE_CONNECTED_N = $00000071; {$EXTERNALSYM PRODUCT_CORE_CONNECTED_N} PRODUCT_PROFESSIONAL_STUDENT_N = $00000072; {$EXTERNALSYM PRODUCT_PROFESSIONAL_STUDENT_N} PRODUCT_CORE_CONNECTED_SINGLELANGUAGE = $00000073; {$EXTERNALSYM PRODUCT_CORE_CONNECTED_SINGLELANGUAGE} PRODUCT_CORE_CONNECTED_COUNTRYSPECIFIC = $00000074; {$EXTERNALSYM PRODUCT_CORE_CONNECTED_COUNTRYSPECIFIC} PRODUCT_CONNECTED_CAR = $00000075; {$EXTERNALSYM PRODUCT_CONNECTED_CAR} PRODUCT_INDUSTRY_HANDHELD = $00000076; {$EXTERNALSYM PRODUCT_INDUSTRY_HANDHELD} PRODUCT_PPI_PRO = $00000077; {$EXTERNALSYM PRODUCT_PPI_PRO} PRODUCT_ARM64_SERVER = $00000078; {$EXTERNALSYM PRODUCT_ARM64_SERVER} PRODUCT_EDUCATION = $00000079; // Windows 10 Education {$EXTERNALSYM PRODUCT_EDUCATION} PRODUCT_EDUCATION_N = $0000007A; // Windows 10 Education {$EXTERNALSYM PRODUCT_EDUCATION_N} PRODUCT_IOTUAP = $0000007B; // Windows 10 IoT Core {$EXTERNALSYM PRODUCT_IOTUAP} PRODUCT_CLOUD_HOST_INFRASTRUCTURE_SERVER = $0000007C; {$EXTERNALSYM PRODUCT_CLOUD_HOST_INFRASTRUCTURE_SERVER} PRODUCT_ENTERPRISE_S = $0000007D; // Windows 10 Enterprise 2015 LTSB {$EXTERNALSYM PRODUCT_ENTERPRISE_S} PRODUCT_ENTERPRISE_S_N = $0000007E; // Windows 10 Enterprise 2015 LTSB {$EXTERNALSYM PRODUCT_ENTERPRISE_S_N} PRODUCT_PROFESSIONAL_S = $0000007F; {$EXTERNALSYM PRODUCT_PROFESSIONAL_S} PRODUCT_PROFESSIONAL_S_N = $00000080; {$EXTERNALSYM PRODUCT_PROFESSIONAL_S_N} PRODUCT_ENTERPRISE_S_EVALUATION = $00000081; // Windows 10 Enterprise 2015 LTSB {$EXTERNALSYM PRODUCT_ENTERPRISE_S_EVALUATION} PRODUCT_ENTERPRISE_S_N_EVALUATION = $00000082; // Windows 10 Enterprise 2015 LTSB {$EXTERNALSYM PRODUCT_ENTERPRISE_S_N_EVALUATION} PRODUCT_IOTUAPCOMMERCIAL = $00000083; // Windows 10 IoT Core Commercial {$EXTERNALSYM PRODUCT_IOTUAPCOMMERCIAL} PRODUCT_MOBILE_ENTERPRISE = $00000085; // Windows 10 Mobile Enterprise {$EXTERNALSYM PRODUCT_MOBILE_ENTERPRISE} PRODUCT_CLOUD = $000000B2; // Windows 10 S {$EXTERNALSYM PRODUCT_CLOUD} PRODUCT_CLOUDN = $000000B3; // Windows 10 S N {$EXTERNALSYM PRODUCT_CLOUDN} implementation function MagDateTimeToAStr(const DateTime: TDateTime): string; // always alpha month and numeric hh:mm:ss begin DateTimeToString(Result, DateTimeAlphaMask, DateTime); end; function MagDateToAStr(const DateTime: TDateTime): string; // always alpha month begin DateTimeToString(Result, DateAlphaMask, DateTime); end; function MagFillStr (const Ch : Char; const N : Integer): string; var I: integer ; begin SetLength (Result, N); for I := 1 to N do Result [I] := Char (Ch) ; end; function MagPadChLeftStr (const S : string; const Ch : Char; const Len : Integer): string; var N: Integer; begin N := Length (S); if N < Len then Result := MagFillStr (Ch, Len - N) + S else Result := S; end; // add leading zeros function MagInt2StrZ (L, Len: Integer): String; begin Result := IntToStr (L); Result := MagPadChLeftStr (Copy (Result, 1, Len), '0', Len); end; // must turn off range checking or encyption stuff dies !!!!! {$R-} {$Q-} // encryption stuff, based on Borland but a little more random, encrypted string is binary values const D2 = 52845; function MagstrREncrypt(const S: AnsiString; Key: Word): AnsiString; var I, len: integer; D1: word ; outstr: string [255] ; begin len := Length(S) ; if len <> 0 then begin Randomize; D1 := Random (65535) ; Key := Key + D1 ; outstr [0] := AnsiChar (Len + 2) ; Move (D1, outstr [1], 2) ; // keep multiply value for I := 1 to Len do begin outstr [I + 2] := AnsiChar (Ord (S [I]) xor (Key shr 8)); Key := (Ord (outstr [I + 2]) + Key) * D1 + D2; end ; end ; result := copy (outstr, 1, len + 2) ; end; function MagstrRDecrypt(const S: AnsiString; Key: Word): AnsiString; var I, len: Integer; D1: word ; outstr: string [255] ; begin len := Length(S) ; if len > 2 then begin Move (S [1], D1, 2) ; // keep multiply value Key := Key + D1 ; outstr [0] := AnsiChar (len - 2) ; for I := 1 to Len do begin outstr[I] := AnsiChar (Ord (S [I + 2]) xor (Key shr 8)); Key := (Ord (S [I + 2]) + Key) * D1 + D2; end; end ; result := copy (outstr, 1, len - 2) ; end; {$R+} {$Q+} // encryption stuff converted into base64 alphanbetic, with length, max 254 ish // information, returns blank if illegal function MagstrBXEncrypt(const S: String; Key: Word): String; var temp: AnsiString ; begin result := '' ; if Length (S) > 254 then exit ; temp := MagstrREncrypt (AnsiString (S), Key) ; temp := AnsiString (MagInt2StrZ (length (temp), 3)) + temp ; // add length to start // 7 Aug 2010 result := String(Base64encode (temp)) ; end ; function MagstrBXDecrypt(const S: String; Key: Word): String; var keylen: integer; temp: AnsiString ; begin result := '' ; try temp := Base64decode (AnsiString(S)) ; if length (temp) < 4 then exit ; keylen := atoi(copy (temp, 1, 3)) ; // get length from start // 7 Aug 2010 if keylen = 0 then exit ; if (keylen + 3) <> length (temp) then exit ; temp := copy (temp, 4, 999) ; result := String (MagstrRDecrypt (temp, Key)) ; except ; result := '' ; end ; end ; // 15 Oct 2010 if decryption fails, assume it was clear text function MagstrBXDecryptEx(const S: String; Key: Word): String; var keylen, strlen: integer; temp: AnsiString ; begin result := '' ; if S = '' then exit ; try temp := Base64decode (AnsiString(S)) ; strlen := length (temp) ; if (strlen = 3) and (temp = '000') then exit ; // blank encoded string if (strlen > 3) then begin keylen := atoi(Copy (temp, 1, 3)) ; // get length from start // 7 Aug 2010 if (keylen + 3) = strlen then begin temp := Copy (temp, 4, 999) ; result := String (MagstrRDecrypt (temp, Key)) ; end; end; if result = '' then result := S ; // blank except ; result := '' ; end ; end; function MagCheckUniqueInstance: Boolean ; var AppString: WideString ; // Unicode I: integer ; begin AppString := Uppercase (ExtractFileName (ParamStr(0))) ; if AppString = '' then AppString := 'UNKNOWN' ; AppString := 'APPLICATION-' + AppString ; for I := 1 to Length (AppString) do begin if AppString [I] = '\' then AppString [I] := '_'; end; // Check to see if the mutex is already there InstanceMutexHandle := OpenMutexW (MUTEX_ALL_ACCESS, false, PWideChar (AppString)) ; // no handle, this is the first instance, create new mutex if InstanceMutexHandle = 0 then begin InstanceMutexHandle := CreateMutexW (nil, false, PWideChar (AppString)) ; // Error checking to see if anyone beat us... if InstanceMutexHandle = 0 then result := false else result := true; end else result := false; end; function MagFormatLastError: string ; begin result := SysErrorMessage (GetLastError) + ' [' + IcsIntToCStr (GetLastError) + ']' ; end ; // get a string HLM registry entry - Nov 2017 function MagGetRegHlmStr (const RegKey, RegValue: string): string ; var IniFile: TRegistry ; begin result := '' ; IniFile := TRegistry.Create ; Try with IniFile do begin try RootKey := HKEY_LOCAL_MACHINE; Access := KEY_QUERY_VALUE ; if OpenKey (RegKey, false) then begin if ValueExists (RegValue) then begin if GetDataType (RegValue) = rdString then result := ReadString (RegValue) ; end; end ; CloseKey ; except end ; end ; finally if Assigned (IniFile) then IniFile.Free; end; end ; // GetProductInfo is Vista and later only 10 Aug 2010 function LoadProdInfoPtr: Boolean; var Kernel: THandle; begin Result := false ; if (OsInfo.dwPlatformId <> VER_PLATFORM_WIN32_NT) then exit ; if (OsInfo.dwMajorVersion < 6) then exit ; Kernel := GetModuleHandle(Kernel32) ; if Kernel = 0 then exit ; Result := true ; if NOT Assigned (GetProductInfo) then begin @GetProductInfo := GetProcAddress (Kernel, 'GetProductInfo') ; @VerifyVersionInfoW := GetProcAddress (Kernel, 'VerifyVersionInfoW') ; // 10 March 2014 - W2K and later @VerSetConditionMask := GetProcAddress (Kernel, 'VerSetConditionMask') ; // 10 March 2014 - W2K and later end ; end; // 10 March 2014 see if touch tablet function MagIsTouchTablet: boolean ; var mask: DWORD ; begin result := false ; if (OsInfo.dwMajorVersion >= 6) and (GetSystemMetrics (SM_TABLETPC) > 0) then begin mask := GetSystemMetrics (SM_DIGITIZER) ; if mask > 0 then result := true ; // could check for specific digitizers... end; end; function MagIsWin64: boolean ; // 3 August 2011 begin {$IFDEF CPUX64} result := true ; {$ELSE} result := false ; {$ENDIF} end ; // 14 Dec 2009 are we running under a 64-bit windows OS function MagIsWow64: boolean ; var IsWow64Process: TIsWow64Process; flag: BOOL; begin result := false ; IsWow64Process := GetProcAddress (GetModuleHandle ('kernel32'), 'IsWow64Process') ; if Assigned(IsWow64Process) then begin flag := false ; // warning, returns false for 64-bit application under 64-bit windows if IsWow64Process (GetCurrentProcess(), flag) then result := flag ; end ; end ; function MagGetOSVersion: string ; var info, inf2, inf3: string ; ProductType: longword ; // 10 Aug 2010 begin if OsInfo.dwPlatformId = 0 then MagGetOSInfo ; case OsInfo.dwPlatformId of VER_PLATFORM_WIN32s: info := 'Windows 3.1'; VER_PLATFORM_WIN32_WINDOWS: begin info := 'Windows 95'; if OsInfo.dwMinorVersion >= 10 then info := 'Windows 98'; if OsInfo.dwMinorVersion >= 90 then info := 'Windows ME'; end ; VER_PLATFORM_WIN32_NT: begin inf2 := '' ; inf3 := '' ; if OsInfo.wProductType = VER_NT_WORKSTATION then inf2 := ' WS' ; if OsInfo.wProductType = VER_NT_DOMAIN_CONTROLLER then inf2 := ' Domain Cont' ; if OsInfo.wProductType = VER_NT_SERVER then inf2 := ' Server' ; if (OsInfo.wSuiteMask AND VER_SUITE_SMALLBUSINESS) <> 0 then inf2 := ' SmallBus' ; if (OsInfo.wSuiteMask AND VER_SUITE_ENTERPRISE) <> 0 then inf2 := ' Enterprise' ; if (OsInfo.wSuiteMask AND VER_SUITE_DATACENTER) <> 0 then inf2 := ' Datacentre' ; if (OsInfo.wSuiteMask AND VER_SUITE_BLADE) <> 0 then inf2 := ' Web Server' ; if (OsInfo.wSuiteMask AND VER_SUITE_STORAGE_SERVER) <> 0 then inf2 := ' Storage Server' ; if (OsInfo.wSuiteMask AND VER_SUITE_COMPUTE_SERVER) <> 0 then inf2 := ' Compute Cluster' ; info := 'Windows NT' + inf2 ; // 16 Aug 2010 Vista and later reports editions with new API and literals if OsInfo.dwMajorVersion >= 6 then begin if NOT LoadProdInfoPtr then exit ; if GetProductInfo (OsInfo.dwMajorVersion, OsInfo.dwMinorVersion, OsInfo.wServicePackMajor, OsInfo.wServicePackMinor, ProductType) then begin case ProductType of PRODUCT_ULTIMATE, PRODUCT_ULTIMATE_E: inf3 := ' Ultimate' ; PRODUCT_PROFESSIONAL, PRODUCT_PROFESSIONAL_E: inf3 := ' Professional' ; PRODUCT_HOME_PREMIUM, PRODUCT_HOME_PREMIUM_E: inf3 := ' Home Premium' ; PRODUCT_HOME_BASIC, PRODUCT_HOME_BASIC_E: inf3 := ' Home Basic' ; PRODUCT_ENTERPRISE, PRODUCT_ENTERPRISE_E: inf3 := ' Enterprise' ; PRODUCT_ENTERPRISE_S, PRODUCT_ENTERPRISE_S_N: inf3 := ' Enterprise 2015 LTSB' ; // Nov 2017 PRODUCT_BUSINESS: inf3 := ' Business' ; PRODUCT_STARTER, PRODUCT_STARTER_E: inf3 := ' Starter' ; PRODUCT_CLUSTER_SERVER, PRODUCT_CLUSTER_SERVER_V: inf3 := ' HPC Server' ; PRODUCT_DATACENTER_SERVER: inf3 := ' Datacenter' ; PRODUCT_DATACENTER_SERVER_CORE: inf3 := ' Datacenter (core)' ; PRODUCT_ENTERPRISE_SERVER: inf3 := ' Enterprise' ; PRODUCT_ENTERPRISE_SERVER_CORE: inf3 := ' Enterprise (core)' ; PRODUCT_ENTERPRISE_SERVER_IA64: inf3 := ' Enterprise Itanium' ; PRODUCT_SMALLBUSINESS_SERVER: inf3 := ' Small Business Server' ; PRODUCT_SMALLBUSINESS_SERVER_PREMIUM:inf3 := ' Small Business Server Premium' ; PRODUCT_STANDARD_SERVER: inf3 := ' Standard' ; PRODUCT_STANDARD_SERVER_CORE: inf3 := ' Standard (core)' ; PRODUCT_WEB_SERVER: inf3 := ' Web Server' ; PRODUCT_NANO_SERVER: inf3 := ' Nano Server' ; // Nov 2017 PRODUCT_EMBEDDED: inf3 := ' Embedded' ; PRODUCT_HYPERV: inf3 := ' Hyper-V' ; PRODUCT_HOME_SERVER: inf3 := ' Home Server' ; PRODUCT_CORE, PRODUCT_CORE_N, PRODUCT_CORE_SINGLELANGUAGE: inf3 := ' Home' ; // Nov 2017 Windows 10 Home PRODUCT_CLOUD, PRODUCT_CLOUDN: inf3 := ' S' ; // Nov 2017 Windows S (streamlined, school) PRODUCT_HOME_PREMIUM_SERVER: inf3 := ' Home Premium Server' ; PRODUCT_CORE_ARM: inf3 := ' ARM' ; // Windows 8, PRODUCT_CORE_COUNTRYSPECIFIC: inf3 := ' China' ; // Nov 2017 PRODUCT_IOTUAP, PRODUCT_IOTUAPCOMMERCIAL: inf3 := ' IoT Core' ; // Nov 2017 PRODUCT_EDUCATION, PRODUCT_EDUCATION_N: inf3 := ' Education' ; // Nov 2017 PRODUCT_MOBILE_CORE, PRODUCT_MOBILE_ENTERPRISE: inf3 := ' Mobile' ; // Nov 2017 else inf3 := ' Unknown ProductType x' + IntToHex (ProductType, 2) ; end; end; end; // now find major version name if OsInfo.dwMajorVersion = 5 then begin info := 'Windows 2000' + inf2 ; if OsInfo.dwMinorVersion = 1 then begin if OsInfo.wProductType <= VER_NT_WORKSTATION then begin if (OsInfo.wSuiteMask AND VER_SUITE_PERSONAL) <> 0 then begin if GetSystemMetrics (SM_MEDIACENTER) > 0 then info := 'Windows XP Media Centre' else if GetSystemMetrics (SM_STARTER) > 0 then info := 'Windows XP Starter' else if GetSystemMetrics (SM_TABLETPC) > 0 then info := 'Windows XP Tablet PC' else info := 'Windows XP Home' ; end else if ((OsInfo.wSuiteMask AND VER_SUITE_EMBEDDEDNT) <> 0) or ((OsInfo.wSuiteMask AND VER_SUITE_EMBEDDED_RESTRICTED) <> 0) then info := 'Windows XP Embedded' else if ((OsInfo.wSuiteMask AND VER_SUITE_WH_SERVER) <> 0) then info := 'Windows Home Server' else info := 'Windows XP Pro' ; end ; end else if OsInfo.dwMinorVersion = 2 then begin if GetSystemMetrics (SM_SERVERR2)> 0 then info := 'Windows Server 2003 R2' + inf2 else info := 'Windows Server 2003' + inf2 end else if OsInfo.dwMinorVersion >= 3 then info := 'Unknown Windows 2000 version' ; end else if OsInfo.dwMajorVersion = 6 then begin if OsInfo.dwMinorVersion = 0 then begin if OsInfo.wProductType <= VER_NT_WORKSTATION then info := 'Windows Vista' + inf3 else info := 'Windows Server 2008' + inf3 ; // Longhorn end else if OsInfo.dwMinorVersion = 1 then begin if OsInfo.wProductType <= VER_NT_WORKSTATION then info := 'Windows 7' + inf3 // 4 Nov 2008 else info := 'Windows Server 2008 R2' + inf3 ; // 22 Jan 2009 end else if OsInfo.dwMinorVersion = 2 then begin if OsInfo.wProductType <= VER_NT_WORKSTATION then info := 'Windows 8' + inf3 // 7 July 2011 else info := 'Windows Server 2012' + inf3 ; // 6 July 2012 end else if OsInfo.dwMinorVersion = 3 then begin if OsInfo.wProductType <= VER_NT_WORKSTATION then info := 'Windows 8.1' + inf3 // 3 April 2013 else info := 'Windows Server 2012 R2' + inf3 ; end else info := 'Unknown Windows 6 version' ; end else if OsInfo.dwMajorVersion = 10 then // 16 Apr 2015 begin // Nov 2017 added version, ie 1709 inf2 := MagGetRegHlmStr (CVNTKey, 'DisplayVersion') ; // July 2021 20H2, replaces ReleaseId 21H2 etc if inf2 = '' then inf2 := MagGetRegHlmStr (CVNTKey, 'ReleaseId'); // last used for 2009 if inf2 <> '' then inf3 := inf3 + IcsSpace + inf2; if (OsInfo.dwMinorVersion = 0) then begin if OsInfo.wProductType <= VER_NT_WORKSTATION then begin if OsInfo.dwBuildNumber >= 27000 then // guessing info := 'Windows 12' + inf3 // July 2024 else if OSInfo.dwBuildNumber >= 20000 then // Windows 11 seems to be build number based info := 'Windows 11' + inf3 // July 2021 else info := 'Windows 10' + inf3; // 3 Oct 2014 end else begin if OsInfo.dwBuildNumber >= 26000 then // Server 2025 info := 'Windows Server 2025' + inf3 // July 2024 else if OsInfo.dwBuildNumber >= 20000 then // Server 2022 info := 'Windows Server 2022' + inf3 // July 2021 else if OsInfo.dwBuildNumber >= 17677 then // Server 2019 preview 1803, should be 1809! info := 'Windows Server 2019' + inf3 // Oct 2018 else info := 'Windows Server 2016' + inf3 ; // July 2015 end; end else info := 'Unknown Windows 10 version' ; end else info := 'Unknown Windows Major version' ; end else info := 'Unknown Windows platform' ; end; // 10 March 2014 see if tablet if MagIsTouchTablet then info := info + ' Tablet' ; if MagIsWin64 then // 22 July 2011 info := info + ' Win64 ' else if MagIsWow64 then // 14 Dec 2009 info := info + ' 64-bit ' else info := info + ' 32-bit ' ; info := info + IntToStr(OsInfo.dwMajorVersion) + '.' + IntToStr(OsInfo.dwMinorVersion) + '.' + IntToStr(LOWORD(OsInfo.dwBuildNumber)) ; if (OsInfo.szCSDVersion [0] <> #0) and (OsInfo.wServicePackMajor > 0) then info := info + ' SP' + IntToStr (OsInfo.wServicePackMajor) else if OsInfo.szCSDVersion <> '' then info := info + ' ' + OsInfo.szCSDVersion ; result := info ; end ; // 8 Aug 2002 - try and get extended info with service packs and product // 10 March 2014 - with Windows 8.1 and later GetVersionEx returns 8.0 unless manifest says 8.1 or 10 compatible. // Aug 2015 kernel mode version gets accurate OS // note this function is called from Initliasation of this unit procedure MagGetOSInfo ; begin FillChar (OsInfo, sizeof (TOSVERSIONINFOEXW), 0) ; FillChar (OsInfoRaw, sizeof (TOSVERSIONINFOEXW), 0) ; OsInfo.dwOSVersionInfoSize := sizeof (TOSVERSIONINFOEXW); // NT4 SP6 and later OsInfoRaw.dwOSVersionInfoSize := sizeof (TOSVERSIONINFOEXW); // NT4 SP6 and later if NOT GetVersionExW2 (OsInfoRaw) then begin OsInfoRaw.dwOSVersionInfoSize := sizeof (TOSVERSIONINFOW); // fall back to older version GetVersionExW2 (OsInfoRaw) ; end; if RtlGetVersion (OsInfo) <> 0 then // Aug 2015 kernel mode version gets accurate OS - Windows 2000 and later begin OsInfo := OsInfoRaw ; // not available, fall back end; end ; // This function gets program version information from the string resources // keys include FileDescription, FileVersion, ProductVersion function MagGetFileVerInfo (const AppName, KeyName: string): string ; const DEFAULT_LANG_ID = $0409; DEFAULT_CHAR_SET_ID = $04E4; type TTranslationPair = packed record Lang, CharSet: word; end; PTranslationIDList = ^TTranslationIDList; TTranslationIDList = array[0..MAXINT div SizeOf(TTranslationPair)-1] of TTranslationPair; var buffer, PStr: PWideChar ; bufsize, temp: DWORD ; strsize, IDsLen: UInt ; succflag: boolean ; LangCharSet, lpSubBlock, WideFileName: UnicodeString ; // Unicode Dummy: DWORD; IDs: PTranslationIDList; // IDCount: integer; begin result := '' ; WideFileName := AppName ; bufsize := GetFileVersionInfoSizeW (PWideChar(WideFileName), temp) ; if bufsize = 0 then exit ; GetMem (buffer, bufsize) ; try // get all version info into buffer succflag := GetFileVersionInfoW (PWideChar(WideFileName), 0, bufsize, buffer) ; if NOT succflag then exit ; // set language Id LangCharSet := '040904E4' ; lpSubBlock := '\VarFileInfo\Translation' ; if VerQueryValueW (buffer, PWideChar (lpSubBlock), Pointer(IDs), IDsLen) then begin // IDCount := IDsLen div SizeOf(TTranslationPair); // for Dummy := 0 to IDCount-1 do // only need first language // begin Dummy := 0 ; if (IDs^[Dummy].Lang = 0) and (IDs^[Dummy].CharSet = 0) then // 16 Aug 2011 charset may be zero so don't set default begin IDs^[Dummy].Lang := DEFAULT_LANG_ID; IDs^[Dummy].CharSet := DEFAULT_CHAR_SET_ID; end; LangCharSet := Format('%.4x%.4x', [IDs^[Dummy].Lang, IDs^[Dummy].CharSet]) ; // end; end; // now read real information lpSubBlock := '\StringFileInfo\' + LangCharSet + '\' + KeyName ; succflag := VerQueryValueW (buffer, PWideChar (lpSubBlock), Pointer (PStr), strsize) ; temp := strsize ; if succflag then result := PStr ; finally FreeMem (buffer) ; end ; end ; Initialization finalization if InstanceMutexHandle <> 0 then begin CloseHandle (InstanceMutexHandle) ; InstanceMutexHandle := 0 ; end ; end.