Mark van Renswoude
0a35f987f0
Added: X2UtProcess unit Changed: on-demand loading for App.Version (optimization for creating multiple instances in multi-threaded situations) Fixed: revert BeginSection calls in X2UtPersist on failure Fixed: use BoolToStr instead of ReadInteger for boolean registry values
278 lines
7.1 KiB
ObjectPascal
278 lines
7.1 KiB
ObjectPascal
{
|
|
:: X2UtOS provides a singleton OS object to access properties associated
|
|
:: with the Operating System, such as the version number.
|
|
:: It is part of the X2Utils suite.
|
|
::
|
|
:: Last changed: $Date$
|
|
:: Revision: $Rev$
|
|
:: Author: $Author$
|
|
}
|
|
unit X2UtOS;
|
|
|
|
interface
|
|
uses
|
|
Windows;
|
|
|
|
type
|
|
//:$ Enumeration of the recognized Operating System versions
|
|
TX2OSVersion = (osWin95, osWin98, osWinME, osWinNT3, osWinNT4,
|
|
osWin2K, osWinXP, osWin2003, osWinVista, osUnknown);
|
|
|
|
//:$ Record to hold the Common Controls version
|
|
TX2CCVersion = record
|
|
Major: Cardinal;
|
|
Minor: Cardinal;
|
|
Build: Cardinal;
|
|
end;
|
|
|
|
{
|
|
:$ Contains extended version information for the Operating System
|
|
}
|
|
TX2OSVersionEx = class(TObject)
|
|
private
|
|
FName: String;
|
|
FVersionString: String;
|
|
FBuild: Cardinal;
|
|
FRawInfo: TOSVersionInfo;
|
|
public
|
|
//:$ Contains the name of the OS
|
|
property Name: String read FName write FName;
|
|
|
|
//:$ Contains a string representation of the OS' version
|
|
property VersionString: String read FVersionString write FVersionString;
|
|
|
|
//:$ Contains the build number of the OS
|
|
property Build: Cardinal read FBuild write FBuild;
|
|
|
|
//:$ Contains the raw version information as provided by the OS
|
|
property RawInfo: TOSVersionInfo read FRawInfo write FRawInfo;
|
|
end;
|
|
|
|
{
|
|
:$ Container for the Operating System's information
|
|
}
|
|
TX2OS = class(TObject)
|
|
private
|
|
FCCVersion: TX2CCVersion;
|
|
FVersion: TX2OSVersion;
|
|
FVersionEx: TX2OSVersionEx;
|
|
|
|
function GetXPManifest(): Boolean;
|
|
protected
|
|
procedure GetVersion(); virtual;
|
|
procedure GetCCVersion(); virtual;
|
|
public
|
|
constructor Create();
|
|
destructor Destroy(); override;
|
|
|
|
//:$ Returns the formatted version information
|
|
//:: If Build is False, the return value will not include the
|
|
//:: OS' Build number.
|
|
function FormatVersion(Build: Boolean = True): String;
|
|
|
|
//:$ Contains the Common Controls version
|
|
property ComCtlVersion: TX2CCVersion read FCCVersion;
|
|
|
|
//:$ Checks if the application uses an XP manifest
|
|
//:: If present, Common Controls version 6 or higher is available.
|
|
property XPManifest: Boolean read GetXPManifest;
|
|
|
|
//:$ Contains the detected OS version
|
|
property Version: TX2OSVersion read FVersion;
|
|
|
|
//:$ Contains extended OS version information
|
|
property VersionEx: TX2OSVersionEx read FVersionEx;
|
|
end;
|
|
|
|
function OS(): TX2OS;
|
|
|
|
implementation
|
|
uses
|
|
SysUtils;
|
|
|
|
const
|
|
ComCtl32 = 'comctl32.dll';
|
|
|
|
type
|
|
PDllVersionInfo = ^TDllVersionInfo;
|
|
TDllVersionInfo = record
|
|
cbSize: DWORD;
|
|
dwMajorVersion: DWORD;
|
|
dwMinorVersion: DWORD;
|
|
dwBuildNumber: DWORD;
|
|
dwPlatformID: DWORD;
|
|
end;
|
|
|
|
TDllGetVersion = function(pdvi: PDllVersionInfo): HRESULT; stdcall;
|
|
|
|
var
|
|
GOS: TX2OS;
|
|
|
|
|
|
{========================================
|
|
Singleton
|
|
========================================}
|
|
function OS;
|
|
begin
|
|
if not Assigned(GOS) then
|
|
GOS := TX2OS.Create();
|
|
|
|
Result := GOS;
|
|
end;
|
|
|
|
|
|
{================================== TX2OS
|
|
Initialization
|
|
========================================}
|
|
constructor TX2OS.Create;
|
|
begin
|
|
inherited;
|
|
|
|
FVersionEx := TX2OSVersionEx.Create();
|
|
GetVersion();
|
|
GetCCVersion();
|
|
end;
|
|
|
|
destructor TX2OS.Destroy;
|
|
begin
|
|
FreeAndNil(FVersionEx);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
|
|
{================================== TX2OS
|
|
Version
|
|
========================================}
|
|
procedure TX2OS.GetVersion;
|
|
var
|
|
pVersion: TOSVersionInfo;
|
|
|
|
begin
|
|
FVersion := osUnknown;
|
|
|
|
{ Get version information }
|
|
pVersion.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
|
|
GetVersionEx(pVersion);
|
|
|
|
with FVersionEx do
|
|
begin
|
|
{ No Kylix support yet, sorry! }
|
|
RawInfo := pVersion;
|
|
Name := 'Windows';
|
|
|
|
case pVersion.dwMajorVersion of
|
|
3: { Windows NT 3.51 }
|
|
FVersion := osWinNT3;
|
|
4: { Windows 95/98/ME/NT 4 }
|
|
case pVersion.dwMinorVersion of
|
|
0: { Windows 95/NT 4 }
|
|
case pVersion.dwPlatformId of
|
|
VER_PLATFORM_WIN32_NT: { Windows NT 4 }
|
|
FVersion := osWinNT4;
|
|
VER_PLATFORM_WIN32_WINDOWS: { Windows 95 }
|
|
FVersion := osWin95;
|
|
end;
|
|
10: { Windows 98 }
|
|
FVersion := osWin98;
|
|
90: { Windows ME }
|
|
FVersion := osWinME;
|
|
end;
|
|
5: { Windows 2000/XP/2003 }
|
|
case pVersion.dwMinorVersion of
|
|
0: { Windows 2000 }
|
|
FVersion := osWin2K;
|
|
1: { Windows XP }
|
|
FVersion := osWinXP;
|
|
2: { Windows Server 2003 }
|
|
FVersion := osWin2003;
|
|
end;
|
|
6: { Windows Vista/Server 2008 }
|
|
FVersion := osWinVista;
|
|
end;
|
|
|
|
case Version of
|
|
osWin95: VersionString := '95';
|
|
osWin98: VersionString := '98';
|
|
osWinME: VersionString := 'ME';
|
|
osWinNT3: VersionString := 'NT 3.51';
|
|
osWinNT4: VersionString := 'NT 4';
|
|
osWin2K: VersionString := '2000';
|
|
osWinXP: VersionString := 'XP';
|
|
osWin2003: VersionString := 'Server 2003';
|
|
osWinVista: VersionString := 'Vista';
|
|
osUnknown: VersionString := Format('%d.%d', [pVersion.dwMajorVersion,
|
|
pVersion.dwMinorVersion]);
|
|
end;
|
|
|
|
if StrLen(pVersion.szCSDVersion) > 0 then
|
|
VersionString := VersionString + ' ' + pVersion.szCSDVersion;
|
|
|
|
case pVersion.dwPlatformId of
|
|
VER_PLATFORM_WIN32_NT:
|
|
Build := pVersion.dwBuildNumber;
|
|
VER_PLATFORM_WIN32_WINDOWS:
|
|
Build := LoWord(pVersion.dwBuildNumber);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TX2OS.GetCCVersion;
|
|
var
|
|
DllGetVersion: TDllGetVersion;
|
|
hLib: THandle;
|
|
viVersion: TDllVersionInfo;
|
|
|
|
begin
|
|
FillChar(FCCVersion, SizeOf(FCCVersion), #0);
|
|
hLib := LoadLibrary(ComCtl32);
|
|
|
|
if hLib <> 0 then
|
|
begin
|
|
@DllGetVersion := GetProcAddress(hLib, 'DllGetVersion');
|
|
if Assigned(DllGetVersion) then
|
|
begin
|
|
FillChar(viVersion, SizeOf(viVersion), #0);
|
|
viVersion.cbSize := SizeOf(viVersion);
|
|
|
|
DllGetVersion(@viVersion);
|
|
|
|
with FCCVersion do
|
|
begin
|
|
Major := viVersion.dwMajorVersion;
|
|
Minor := viVersion.dwMinorVersion;
|
|
Build := viVersion.dwBuildNumber;
|
|
end;
|
|
end;
|
|
|
|
FreeLibrary(hLib);
|
|
end;
|
|
end;
|
|
|
|
function TX2OS.GetXPManifest;
|
|
begin
|
|
Result := (FCCVersion.Major >= 6);
|
|
end;
|
|
|
|
|
|
function TX2OS.FormatVersion;
|
|
var
|
|
sBuild: String;
|
|
|
|
begin
|
|
sBuild := '';
|
|
|
|
if Build then
|
|
sBuild := Format(' build %d', [FVersionEx.Build]);
|
|
|
|
with FVersionEx do
|
|
Result := Format('%s %s%s', [Name, VersionString, sBuild]);
|
|
end;
|
|
|
|
|
|
initialization
|
|
finalization
|
|
FreeAndNil(GOS);
|
|
|
|
end.
|