1
0
mirror of synced 2024-12-22 17:23:07 +01:00

Added: X2UtOS now supports Windows 7 and Server 2008

Added: X2UtElevation unit for writing UAC compatible applications
This commit is contained in:
Mark van Renswoude 2010-01-31 11:18:49 +00:00
parent b08e7df883
commit 35a7e5f5fb
4 changed files with 490 additions and 72 deletions

View File

@ -52,6 +52,7 @@ contains
X2UtPersist in '..\..\X2UtPersist.pas', X2UtPersist in '..\..\X2UtPersist.pas',
X2UtPersistForm in '..\..\X2UtPersistForm.pas', X2UtPersistForm in '..\..\X2UtPersistForm.pas',
X2UtPersistIntf in '..\..\X2UtPersistIntf.pas', X2UtPersistIntf in '..\..\X2UtPersistIntf.pas',
X2UtPersistRegistry in '..\..\X2UtPersistRegistry.pas'; X2UtPersistRegistry in '..\..\X2UtPersistRegistry.pas',
X2UtElevation in '..\..\X2UtElevation.pas';
end. end.

View File

@ -33,16 +33,6 @@
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">X2Utils</Package_Options><Package_Options Name="ImplicitBuild">True</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">True</Package_Options><Package_Options Name="LibSuffix">2007</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1043</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">X2Utils.dpk</Source></Source><Excluded_Packages> <BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">X2Utils</Package_Options><Package_Options Name="ImplicitBuild">True</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">True</Package_Options><Package_Options Name="LibSuffix">2007</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1043</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">X2Utils.dpk</Source></Source><Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages> <Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages> <Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages></Delphi.Personality></BorlandProject></BorlandProject> </Excluded_Packages></Delphi.Personality></BorlandProject></BorlandProject>
@ -52,14 +42,12 @@
<DelphiCompile Include="X2Utils.dpk"> <DelphiCompile Include="X2Utils.dpk">
<MainSource>MainSource</MainSource> <MainSource>MainSource</MainSource>
</DelphiCompile> </DelphiCompile>
<DCCReference Include="$(SystemRoot)\system32\rtl.dcp" />
<DCCReference Include="$(SystemRoot)\system32\vcl.dcp" />
<DCCReference Include="$(SystemRoot)\system32\vclx.dcp" />
<DCCReference Include="$(SystemRoot)\system32\VirtualTreesD207.dcp" /> <DCCReference Include="$(SystemRoot)\system32\VirtualTreesD207.dcp" />
<DCCReference Include="$(SystemRoot)\system32\VirtualTreesD27.dcp" /> <DCCReference Include="$(SystemRoot)\system32\VirtualTreesD27.dcp" />
<DCCReference Include="$(SystemRoot)\system32\VirtualTreesD7.dcp" /> <DCCReference Include="$(SystemRoot)\system32\VirtualTreesD7.dcp" />
<DCCReference Include="..\..\X2UtApp.pas" /> <DCCReference Include="..\..\X2UtApp.pas" />
<DCCReference Include="..\..\X2UtBits.pas" /> <DCCReference Include="..\..\X2UtBits.pas" />
<DCCReference Include="..\..\X2UtElevation.pas" />
<DCCReference Include="..\..\X2UtGraphics.pas" /> <DCCReference Include="..\..\X2UtGraphics.pas" />
<DCCReference Include="..\..\X2UtHandCursor.pas" /> <DCCReference Include="..\..\X2UtHandCursor.pas" />
<DCCReference Include="..\..\X2UtHashes.pas" /> <DCCReference Include="..\..\X2UtHashes.pas" />
@ -78,5 +66,8 @@
<DCCReference Include="..\..\X2UtStreams.pas" /> <DCCReference Include="..\..\X2UtStreams.pas" />
<DCCReference Include="..\..\X2UtStrings.pas" /> <DCCReference Include="..\..\X2UtStrings.pas" />
<DCCReference Include="..\..\X2UtTempFile.pas" /> <DCCReference Include="..\..\X2UtTempFile.pas" />
<DCCReference Include="F:\Development\X2FileShare\Source\UAC\rtl.dcp" />
<DCCReference Include="F:\Development\X2FileShare\Source\UAC\vcl.dcp" />
<DCCReference Include="F:\Development\X2FileShare\Source\UAC\vclx.dcp" />
</ItemGroup> </ItemGroup>
</Project> </Project>

347
X2UtElevation.pas Normal file
View File

@ -0,0 +1,347 @@
{
Helper functions and classes for writing UAC-compatible elevated COM objects.
Backwards-compatible with previous Windows versions.
}
unit X2UtElevation;
interface
uses
ActiveX,
ComObj;
{ Checks if the current process has the elevation token. }
function IsElevated: Boolean;
{ Creates an elevated instance of COM object. Returns False if the
user cancelled the elevation prompt. }
function CoCreateElevatedInstance(AParentWnd: THandle; AClassID: TCLSID;
AIID: TIID; var AIntf): Boolean;
type
(*
Registers a COM object for elevation.
The ResourceID must point to a String Table resource in the current
module and contains the program name to display in the elevation prompt.
An example .rc file:
STRINGTABLE
{
42, "Elevated COM Object"
}
*)
TElevatedClassFactory = class(TTypedComObjectFactory)
private
FResourceID: string;
public
constructor Create(const AResourceID: string; AComServer: TComServerObject;
ATypedComClass: TTypedComClass; const AClassID: TGUID;
AInstancing: TClassInstancing;
AThreadingModel: TThreadingModel = tmSingle);
procedure UpdateRegistry(Register: Boolean); override;
property ResourceID: string read FResourceID;
end;
implementation
uses
ComConst,
SysUtils,
Windows,
X2UtOS;
type
BIND_OPTS3 = packed record
cbStruct: DWORD;
grfFlags: DWORD;
grfMode: DWORD;
dwTickCountDeadline: DWORD;
dwTrackFlags: DWORD;
dwClassContext: DWORD;
locale: LCID;
pServerInfo: PCOSERVERINFO;
hwnd: HWND;
end;
PBIND_OPTS3 = ^BIND_OPTS3;
TOKEN_INFORMATION_CLASS = (
TokenICPad,
TokenUser,
TokenGroups,
TokenPrivileges,
TokenOwner,
TokenPrimaryGroup,
TokenDefaultDacl,
TokenSource,
TokenType,
TokenImpersonationLevel,
TokenStatistics,
TokenRestrictedSids,
TokenSessionId,
TokenGroupsAndPrivileges,
TokenSessionReference,
TokenSandBoxInert,
TokenAuditPolicy,
TokenOrigin,
TokenElevationType,
TokenLinkedToken,
TokenElevation,
TokenHasRestrictions,
TokenAccessInformation,
TokenVirtualizationAllowed,
TokenVirtualizationEnabled,
TokenIntegrityLevel,
TokenUIAccess,
TokenMandatoryPolicy,
TokenLogonSid,
MaxTokenInfoClass
);
TOKEN_ELEVATION = packed record
TokenIsElevated: DWORD;
end;
PTOKEN_ELEVATION = ^TOKEN_ELEVATION;
{ Who in the advapi32 team came up with this name?! Descriptive for sure. }
TConvertStringSecurityDescriptorToSecurityDescriptorA = function(StringSecurityDescriptor: PAnsiChar;
StringSDRevision: Cardinal;
var SecurityDescriptor: PSecurityDescriptor;
var SecurityDescriptorSize: Cardinal): LongBool; stdcall;
TCoGetObject = function(pszName: PWideChar; pBindOptions: PBIND_OPTS3;
const iid: TIID; out ppv): HResult; stdcall; //external 'ole32.dll' name 'CoGetObject';
TOpenProcessToken = function(ProcessHandle: THandle; DesiredAccess: DWORD;
var TokenHandle: THandle): BOOL; stdcall;
TGetTokenInformation = function(TokenHandle: THandle;
TokenInformationClass: TOKEN_INFORMATION_CLASS;
TokenInformation: Pointer;
TokenInformationLength: DWORD;
var ReturnLength: DWORD): BOOL; stdcall;
var
ConvertStringSecurityDescriptorToSecurityDescriptorA: TConvertStringSecurityDescriptorToSecurityDescriptorA;
CoGetObject: TCoGetObject;
OpenProcessToken: TOpenProcessToken;
GetTokenInformation: TGetTokenInformation;
{ Helper functions }
function IsElevated: Boolean;
var
tokenHandle: THandle;
tokenInfo: TOKEN_ELEVATION;
dummy: Cardinal;
begin
Result := False;
if (not Assigned(OpenProcessToken)) or
(not Assigned(GetTokenInformation)) then
Exit;
if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, tokenHandle) then
begin
dummy := 0;
if GetTokenInformation(tokenHandle, TokenElevation, @tokenInfo, SizeOf(TOKEN_ELEVATION), dummy) then
Result := (tokenInfo.TokenIsElevated <> 0);
CloseHandle(tokenHandle);
end;
end;
function CoCreateElevatedInstance(AParentWnd: THandle; AClassID: TCLSID;
AIID: TIID; var AIntf): Boolean;
var
bindOptions: BIND_OPTS3;
monikerName: WideString;
status: HRESULT;
begin
Result := True;
if OS.SupportsUAC and (not IsElevated) then
begin
{ Use elevation moniker }
monikerName := 'Elevation:Administrator!new:' + GUIDToString(AClassID);
FillChar(bindOptions, SizeOf(bindOptions), 0);
bindOptions.cbStruct := SizeOf(bindOptions);
bindOptions.dwClassContext := CLSCTX_LOCAL_SERVER;
bindOptions.hwnd := AParentWnd;
status := CoGetObject(PWideChar(monikerName), @bindOptions, aIID, AIntf);
if HResultCode(status) = ERROR_CANCELLED then
Result := False
else
OleCheck(status);
end else
{ Use good ole' CoCreateInstance }
OleCheck(CoCreateInstance(AClassID, nil, CLSCTX_ALL, AIID, AIntf));
end;
{ Internal helper functions }
procedure LoadAPIFunctions;
var
dllHandle: THandle;
begin
dllHandle := GetModuleHandle(advapi32);
if dllHandle <> 0 then
begin
@ConvertStringSecurityDescriptorToSecurityDescriptorA := GetProcAddress(dllHandle, 'ConvertStringSecurityDescriptorToSecurityDescriptorA');
@OpenProcessToken := GetProcAddress(dllHandle, 'OpenProcessToken');
@GetTokenInformation := GetProcAddress(dllHandle, 'GetTokenInformation');
end;
dllHandle := GetModuleHandle('ole32.dll');
if dllHandle <> 0 then
@CoGetObject := GetProcAddress(dllHandle, 'CoGetObject');
end;
procedure CreateRegKeyDWORD(const AKey, AValue: string; AData: DWORD; ARootKey: HKEY = HKEY_CLASSES_ROOT);
var
keyHandle: HKEY;
status: Integer;
disposition: Integer;
begin
status := RegCreateKeyEx(ARootKey, PChar(AKey), 0, '',
REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, nil,
keyHandle, @disposition);
if status = ERROR_SUCCESS then
begin
status := RegSetValueEx(keyHandle, PChar(AValue), 0, REG_DWORD,
@AData, SizeOf(DWORD));
RegCloseKey(keyHandle);
end;
if status <> ERROR_SUCCESS then
raise EOleRegistrationError.CreateRes(@SCreateRegKeyError);
end;
procedure SetAccessPermission(const AKey: string);
const
LocalCallSecDesc = 'O:BAG:BAD:(A;;0x3;;;IU)(A;;0x3;;;SY)';
const
SDDL_REVISION_1 = 1;
var
descriptor: PSecurityDescriptor;
size: Cardinal;
keyHandle: HKEY;
begin
if not Assigned(ConvertStringSecurityDescriptorToSecurityDescriptorA) then
Exit;
if not ConvertStringSecurityDescriptorToSecurityDescriptorA(LocalCallSecDesc,
SDDL_REVISION_1,
descriptor, size) then
RaiseLastOSError;
try
if RegOpenKeyExA(HKEY_CLASSES_ROOT, PChar(AKey), 0, KEY_READ or KEY_WRITE, keyHandle) = ERROR_SUCCESS then
try
if RegSetValueExA(keyHandle, PChar('AccessPermission'), 0, REG_BINARY, descriptor, size) <> ERROR_SUCCESS then
RaiseLastOSError;
finally
RegCloseKey(keyHandle);
end else
RaiseLastOSError;
finally
LocalFree(Cardinal(descriptor));
end;
end;
{ TElevatedClassFactory }
constructor TElevatedClassFactory.Create(const AResourceID: string;
AComServer: TComServerObject;
ATypedComClass: TTypedComClass;
const AClassID: TGUID;
AInstancing: TClassInstancing;
AThreadingModel: TThreadingModel);
begin
inherited Create(AComServer, ATypedComClass, AClassID, AInstancing,
AThreadingModel);
FResourceID := AResourceID;
end;
procedure TElevatedClassFactory.UpdateRegistry(Register: Boolean);
var
classIDAsString: string;
filePath: string;
fileName: string;
appRegKey: string;
classRegKey: string;
begin
if not OS.SupportsUAC then
begin
inherited;
Exit;
end;
try
classIDAsString := GUIDToString(Self.ClassID);
filePath := ComServer.ServerFileName;
fileName := ExtractFileName(filePath);
appRegKey := 'AppID\' + classIDAsString;
classRegKey := 'CLSID\' + classIDAsString;
if Register then
begin
inherited;
{ Out-of-process }
CreateRegKey(appRegKey, '', Description);
CreateRegKey(appRegKey, 'DllSurrogate', '');
CreateRegKey('AppID\' + fileName, 'AppID', classIDAsString);
{ Over-The-Shoulder elevation }
SetAccessPermission(appRegKey);
{ COM object elevation }
CreateRegKey(classRegKey, 'AppID', classIDAsString);
CreateRegKey(classRegKey, 'LocalizedString', '@' + filePath + ',-' + fResourceId);
CreateRegKeyDWORD(classRegKey + '\Elevation', 'Enabled', 1);
end else begin
DeleteRegKey(classRegKey + '\Elevation');
DeleteRegKey(appRegKey);
DeleteRegKey('AppID\' + fileName);
inherited;
end;
except
on E: Exception do
raise EOleRegistrationError.Create(E.Message);
end;
end;
initialization
LoadAPIFunctions;
end.

View File

@ -14,9 +14,25 @@ uses
Windows; Windows;
type type
TOSVersionInfoEx = packed record
dwOSVersionInfoSize: DWORD;
dwMajorVersion: DWORD;
dwMinorVersion: DWORD;
dwBuildNumber: DWORD;
dwPlatformId: DWORD;
szCSDVersion: array[0..127] of AnsiChar;
wServicePackMajor: WORD;
wServicePackMinor: WORD;
wSuiteMask: WORD;
wProductType: Byte;
wReserved: Byte;
end;
//:$ Enumeration of the recognized Operating System versions //:$ Enumeration of the recognized Operating System versions
TX2OSVersion = (osWin95, osWin98, osWinME, osWinNT3, osWinNT4, TX2OSVersion = (osWin95, osWin98, osWinME, osWinNT3, osWinNT4,
osWin2K, osWinXP, osWin2003, osWinVista, osUnknown); osWin2K, osWinXP, osWin2003, osWinVista, osWinServer2008,
osWin7, osUnknown);
//:$ Record to hold the Common Controls version //:$ Record to hold the Common Controls version
TX2CCVersion = record TX2CCVersion = record
@ -33,7 +49,7 @@ type
FName: String; FName: String;
FVersionString: String; FVersionString: String;
FBuild: Cardinal; FBuild: Cardinal;
FRawInfo: TOSVersionInfo; FRawInfo: TOSVersionInfoEx;
public public
//:$ Contains the name of the OS //:$ Contains the name of the OS
property Name: String read FName write FName; property Name: String read FName write FName;
@ -45,7 +61,7 @@ type
property Build: Cardinal read FBuild write FBuild; property Build: Cardinal read FBuild write FBuild;
//:$ Contains the raw version information as provided by the OS //:$ Contains the raw version information as provided by the OS
property RawInfo: TOSVersionInfo read FRawInfo write FRawInfo; property RawInfo: TOSVersionInfoEx read FRawInfo write FRawInfo;
end; end;
{ {
@ -57,22 +73,27 @@ type
FVersion: TX2OSVersion; FVersion: TX2OSVersion;
FVersionEx: TX2OSVersionEx; FVersionEx: TX2OSVersionEx;
function GetXPManifest(): Boolean; function GetSupportsUAC: Boolean;
function GetXPManifest: Boolean;
protected protected
procedure GetVersion(); virtual; procedure GetVersion; virtual;
procedure GetCCVersion(); virtual; procedure GetCCVersion; virtual;
public public
constructor Create(); constructor Create;
destructor Destroy(); override; destructor Destroy; override;
//:$ Returns the formatted version information //:$ Returns the formatted version information
//:: If Build is False, the return value will not include the //:: If Build is False, the return value will not include the
//:: OS' Build number. //:: OS' Build number.
function FormatVersion(Build: Boolean = True): String; function FormatVersion(Build: Boolean = True): String;
//:$ Contains the Common Controls version //:$ Contains the Common Controls version
property ComCtlVersion: TX2CCVersion read FCCVersion; property ComCtlVersion: TX2CCVersion read FCCVersion;
//:$ Checks if the OS supports User Account Control
property SupportsUAC: Boolean read GetSupportsUAC;
//:$ Checks if the application uses an XP manifest //:$ Checks if the application uses an XP manifest
//:: If present, Common Controls version 6 or higher is available. //:: If present, Common Controls version 6 or higher is available.
property XPManifest: Boolean read GetXPManifest; property XPManifest: Boolean read GetXPManifest;
@ -84,7 +105,29 @@ type
property VersionEx: TX2OSVersionEx read FVersionEx; property VersionEx: TX2OSVersionEx read FVersionEx;
end; end;
function OS(): TX2OS; function OS: TX2OS;
const
{ NT Product types: used by dwProductType field }
VER_NT_WORKSTATION = $0000001;
VER_NT_DOMAIN_CONTROLLER = $0000002;
VER_NT_SERVER = $0000003;
{ NT product suite mask values: used by wSuiteMask field }
VER_SUITE_SMALLBUSINESS = $00000001;
VER_SUITE_ENTERPRISE = $00000002;
VER_SUITE_BACKOFFICE = $00000004;
VER_SUITE_COMMUNICATIONS = $00000008;
VER_SUITE_TERMINAL = $00000010;
VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020;
VER_SUITE_EMBEDDEDNT = $00000040;
VER_SUITE_DATACENTER = $00000080;
VER_SUITE_SINGLEUSERTS = $00000100;
VER_SUITE_PERSONAL = $00000200;
VER_SUITE_SERVERAPPLIANCE = $00000400;
VER_SUITE_BLADE = VER_SUITE_SERVERAPPLIANCE;
implementation implementation
uses uses
@ -115,7 +158,7 @@ var
function OS; function OS;
begin begin
if not Assigned(GOS) then if not Assigned(GOS) then
GOS := TX2OS.Create(); GOS := TX2OS.Create;
Result := GOS; Result := GOS;
end; end;
@ -128,9 +171,9 @@ constructor TX2OS.Create;
begin begin
inherited; inherited;
FVersionEx := TX2OSVersionEx.Create(); FVersionEx := TX2OSVersionEx.Create;
GetVersion(); GetVersion;
GetCCVersion(); GetCCVersion;
end; end;
destructor TX2OS.Destroy; destructor TX2OS.Destroy;
@ -146,28 +189,39 @@ end;
========================================} ========================================}
procedure TX2OS.GetVersion; procedure TX2OS.GetVersion;
var var
pVersion: TOSVersionInfo; versionInfo: TOSVersionInfoEx;
versionInfoPtr: POSVersionInfo;
begin begin
FVersion := osUnknown; FVersion := osUnknown;
{ Get version information } { Get version information }
pVersion.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); FillChar(versionInfo, SizeOf(versionInfo), 0);
GetVersionEx(pVersion); versionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);
versionInfoPtr := @versionInfo;
if not GetVersionEx(versionInfoPtr^) then
begin
{ Maybe this is an older Windows version, not supporting the Ex fields }
versionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if not GetVersionEx(versionInfoPtr^) then
RaiseLastOSError;
end;
with FVersionEx do with FVersionEx do
begin begin
{ No Kylix support yet, sorry! } { No Kylix support yet, sorry! }
RawInfo := pVersion; RawInfo := versionInfo;
Name := 'Windows'; Name := 'Windows';
case pVersion.dwMajorVersion of case versionInfo.dwMajorVersion of
3: { Windows NT 3.51 } 3: { Windows NT 3.51 }
FVersion := osWinNT3; FVersion := osWinNT3;
4: { Windows 95/98/ME/NT 4 } 4: { Windows 95/98/ME/NT 4 }
case pVersion.dwMinorVersion of case versionInfo.dwMinorVersion of
0: { Windows 95/NT 4 } 0: { Windows 95/NT 4 }
case pVersion.dwPlatformId of case versionInfo.dwPlatformId of
VER_PLATFORM_WIN32_NT: { Windows NT 4 } VER_PLATFORM_WIN32_NT: { Windows NT 4 }
FVersion := osWinNT4; FVersion := osWinNT4;
VER_PLATFORM_WIN32_WINDOWS: { Windows 95 } VER_PLATFORM_WIN32_WINDOWS: { Windows 95 }
@ -179,7 +233,7 @@ begin
FVersion := osWinME; FVersion := osWinME;
end; end;
5: { Windows 2000/XP/2003 } 5: { Windows 2000/XP/2003 }
case pVersion.dwMinorVersion of case versionInfo.dwMinorVersion of
0: { Windows 2000 } 0: { Windows 2000 }
FVersion := osWin2K; FVersion := osWin2K;
1: { Windows XP } 1: { Windows XP }
@ -187,8 +241,23 @@ begin
2: { Windows Server 2003 } 2: { Windows Server 2003 }
FVersion := osWin2003; FVersion := osWin2003;
end; end;
6: { Windows Vista/Server 2008 } 6: { Windows Vista/Server 2008/7 }
if versionInfo.wProductType = VER_NT_WORKSTATION then
begin
case versionInfo.dwMinorVersion of
0: { Windows Vista }
FVersion := osWinVista; FVersion := osWinVista;
1: { Windows 7 }
FVersion := osWin7;
end;
end else
begin
case versionInfo.dwMinorVersion of
0, { Windows Server 2008 }
1: { Windows Server 2008 R2 }
FVersion := osWinServer2008;
end;
end;
end; end;
case Version of case Version of
@ -201,18 +270,21 @@ begin
osWinXP: VersionString := 'XP'; osWinXP: VersionString := 'XP';
osWin2003: VersionString := 'Server 2003'; osWin2003: VersionString := 'Server 2003';
osWinVista: VersionString := 'Vista'; osWinVista: VersionString := 'Vista';
osUnknown: VersionString := Format('%d.%d', [pVersion.dwMajorVersion, osWin7: VersionString := '7';
pVersion.dwMinorVersion]); osWinServer2008: VersionString := 'Server 2008';
else
VersionString := Format('%d.%d', [versionInfo.dwMajorVersion,
versionInfo.dwMinorVersion]);
end; end;
if StrLen(pVersion.szCSDVersion) > 0 then if StrLen(versionInfo.szCSDVersion) > 0 then
VersionString := VersionString + ' ' + pVersion.szCSDVersion; VersionString := VersionString + ' ' + versionInfo.szCSDVersion;
case pVersion.dwPlatformId of case versionInfo.dwPlatformId of
VER_PLATFORM_WIN32_NT: VER_PLATFORM_WIN32_NT:
Build := pVersion.dwBuildNumber; Build := versionInfo.dwBuildNumber;
VER_PLATFORM_WIN32_WINDOWS: VER_PLATFORM_WIN32_WINDOWS:
Build := LoWord(pVersion.dwBuildNumber); Build := LoWord(versionInfo.dwBuildNumber);
end; end;
end; end;
end; end;
@ -249,11 +321,6 @@ begin
end; end;
end; end;
function TX2OS.GetXPManifest;
begin
Result := (FCCVersion.Major >= 6);
end;
function TX2OS.FormatVersion; function TX2OS.FormatVersion;
var var
@ -270,6 +337,18 @@ begin
end; end;
function TX2OS.GetXPManifest;
begin
Result := (FCCVersion.Major >= 6);
end;
function TX2OS.GetSupportsUAC: Boolean;
begin
Result := (FVersionEx.RawInfo.dwMajorVersion >= 6);
end;
initialization initialization
finalization finalization
FreeAndNil(GOS); FreeAndNil(GOS);