Added: X2UtOS now supports Windows 7 and Server 2008
Added: X2UtElevation unit for writing UAC compatible applications
This commit is contained in:
parent
b08e7df883
commit
35a7e5f5fb
@ -52,6 +52,7 @@ contains
|
||||
X2UtPersist in '..\..\X2UtPersist.pas',
|
||||
X2UtPersistForm in '..\..\X2UtPersistForm.pas',
|
||||
X2UtPersistIntf in '..\..\X2UtPersistIntf.pas',
|
||||
X2UtPersistRegistry in '..\..\X2UtPersistRegistry.pas';
|
||||
X2UtPersistRegistry in '..\..\X2UtPersistRegistry.pas',
|
||||
X2UtElevation in '..\..\X2UtElevation.pas';
|
||||
|
||||
end.
|
||||
|
||||
@ -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>
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
<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></Delphi.Personality></BorlandProject></BorlandProject>
|
||||
@ -52,14 +42,12 @@
|
||||
<DelphiCompile Include="X2Utils.dpk">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</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\VirtualTreesD27.dcp" />
|
||||
<DCCReference Include="$(SystemRoot)\system32\VirtualTreesD7.dcp" />
|
||||
<DCCReference Include="..\..\X2UtApp.pas" />
|
||||
<DCCReference Include="..\..\X2UtBits.pas" />
|
||||
<DCCReference Include="..\..\X2UtElevation.pas" />
|
||||
<DCCReference Include="..\..\X2UtGraphics.pas" />
|
||||
<DCCReference Include="..\..\X2UtHandCursor.pas" />
|
||||
<DCCReference Include="..\..\X2UtHashes.pas" />
|
||||
@ -78,5 +66,8 @@
|
||||
<DCCReference Include="..\..\X2UtStreams.pas" />
|
||||
<DCCReference Include="..\..\X2UtStrings.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>
|
||||
</Project>
|
||||
347
X2UtElevation.pas
Normal file
347
X2UtElevation.pas
Normal 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.
|
||||
193
X2UtOS.pas
193
X2UtOS.pas
@ -14,9 +14,25 @@ uses
|
||||
Windows;
|
||||
|
||||
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
|
||||
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
|
||||
TX2CCVersion = record
|
||||
@ -33,19 +49,19 @@ type
|
||||
FName: String;
|
||||
FVersionString: String;
|
||||
FBuild: Cardinal;
|
||||
FRawInfo: TOSVersionInfo;
|
||||
FRawInfo: TOSVersionInfoEx;
|
||||
public
|
||||
//:$ Contains the name of the OS
|
||||
property Name: String read FName write FName;
|
||||
property Name: String read FName write FName;
|
||||
|
||||
//:$ Contains a string representation of the OS' version
|
||||
property VersionString: String read FVersionString write FVersionString;
|
||||
property VersionString: String read FVersionString write FVersionString;
|
||||
|
||||
//:$ Contains the build number of the OS
|
||||
property Build: Cardinal read FBuild write FBuild;
|
||||
property Build: Cardinal read FBuild write FBuild;
|
||||
|
||||
//:$ 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;
|
||||
|
||||
{
|
||||
@ -57,22 +73,27 @@ type
|
||||
FVersion: TX2OSVersion;
|
||||
FVersionEx: TX2OSVersionEx;
|
||||
|
||||
function GetXPManifest(): Boolean;
|
||||
function GetSupportsUAC: Boolean;
|
||||
function GetXPManifest: Boolean;
|
||||
protected
|
||||
procedure GetVersion(); virtual;
|
||||
procedure GetCCVersion(); virtual;
|
||||
procedure GetVersion; virtual;
|
||||
procedure GetCCVersion; virtual;
|
||||
public
|
||||
constructor Create();
|
||||
destructor Destroy(); override;
|
||||
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 OS supports User Account Control
|
||||
property SupportsUAC: Boolean read GetSupportsUAC;
|
||||
|
||||
//:$ Checks if the application uses an XP manifest
|
||||
//:: If present, Common Controls version 6 or higher is available.
|
||||
property XPManifest: Boolean read GetXPManifest;
|
||||
@ -84,7 +105,29 @@ type
|
||||
property VersionEx: TX2OSVersionEx read FVersionEx;
|
||||
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
|
||||
uses
|
||||
@ -115,7 +158,7 @@ var
|
||||
function OS;
|
||||
begin
|
||||
if not Assigned(GOS) then
|
||||
GOS := TX2OS.Create();
|
||||
GOS := TX2OS.Create;
|
||||
|
||||
Result := GOS;
|
||||
end;
|
||||
@ -128,9 +171,9 @@ constructor TX2OS.Create;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FVersionEx := TX2OSVersionEx.Create();
|
||||
GetVersion();
|
||||
GetCCVersion();
|
||||
FVersionEx := TX2OSVersionEx.Create;
|
||||
GetVersion;
|
||||
GetCCVersion;
|
||||
end;
|
||||
|
||||
destructor TX2OS.Destroy;
|
||||
@ -146,73 +189,102 @@ end;
|
||||
========================================}
|
||||
procedure TX2OS.GetVersion;
|
||||
var
|
||||
pVersion: TOSVersionInfo;
|
||||
versionInfo: TOSVersionInfoEx;
|
||||
versionInfoPtr: POSVersionInfo;
|
||||
|
||||
begin
|
||||
FVersion := osUnknown;
|
||||
|
||||
{ Get version information }
|
||||
pVersion.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
|
||||
GetVersionEx(pVersion);
|
||||
FillChar(versionInfo, SizeOf(versionInfo), 0);
|
||||
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
|
||||
begin
|
||||
{ No Kylix support yet, sorry! }
|
||||
RawInfo := pVersion;
|
||||
RawInfo := versionInfo;
|
||||
Name := 'Windows';
|
||||
|
||||
case pVersion.dwMajorVersion of
|
||||
case versionInfo.dwMajorVersion of
|
||||
3: { Windows NT 3.51 }
|
||||
FVersion := osWinNT3;
|
||||
FVersion := osWinNT3;
|
||||
4: { Windows 95/98/ME/NT 4 }
|
||||
case pVersion.dwMinorVersion of
|
||||
case versionInfo.dwMinorVersion of
|
||||
0: { Windows 95/NT 4 }
|
||||
case pVersion.dwPlatformId of
|
||||
case versionInfo.dwPlatformId of
|
||||
VER_PLATFORM_WIN32_NT: { Windows NT 4 }
|
||||
FVersion := osWinNT4;
|
||||
FVersion := osWinNT4;
|
||||
VER_PLATFORM_WIN32_WINDOWS: { Windows 95 }
|
||||
FVersion := osWin95;
|
||||
FVersion := osWin95;
|
||||
end;
|
||||
10: { Windows 98 }
|
||||
FVersion := osWin98;
|
||||
FVersion := osWin98;
|
||||
90: { Windows ME }
|
||||
FVersion := osWinME;
|
||||
FVersion := osWinME;
|
||||
end;
|
||||
5: { Windows 2000/XP/2003 }
|
||||
case pVersion.dwMinorVersion of
|
||||
case versionInfo.dwMinorVersion of
|
||||
0: { Windows 2000 }
|
||||
FVersion := osWin2K;
|
||||
FVersion := osWin2K;
|
||||
1: { Windows XP }
|
||||
FVersion := osWinXP;
|
||||
FVersion := osWinXP;
|
||||
2: { Windows Server 2003 }
|
||||
FVersion := osWin2003;
|
||||
FVersion := osWin2003;
|
||||
end;
|
||||
6: { Windows Vista/Server 2008/7 }
|
||||
if versionInfo.wProductType = VER_NT_WORKSTATION then
|
||||
begin
|
||||
case versionInfo.dwMinorVersion of
|
||||
0: { Windows Vista }
|
||||
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;
|
||||
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]);
|
||||
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';
|
||||
osWin7: VersionString := '7';
|
||||
osWinServer2008: VersionString := 'Server 2008';
|
||||
else
|
||||
VersionString := Format('%d.%d', [versionInfo.dwMajorVersion,
|
||||
versionInfo.dwMinorVersion]);
|
||||
end;
|
||||
|
||||
if StrLen(pVersion.szCSDVersion) > 0 then
|
||||
VersionString := VersionString + ' ' + pVersion.szCSDVersion;
|
||||
if StrLen(versionInfo.szCSDVersion) > 0 then
|
||||
VersionString := VersionString + ' ' + versionInfo.szCSDVersion;
|
||||
|
||||
case pVersion.dwPlatformId of
|
||||
case versionInfo.dwPlatformId of
|
||||
VER_PLATFORM_WIN32_NT:
|
||||
Build := pVersion.dwBuildNumber;
|
||||
Build := versionInfo.dwBuildNumber;
|
||||
VER_PLATFORM_WIN32_WINDOWS:
|
||||
Build := LoWord(pVersion.dwBuildNumber);
|
||||
Build := LoWord(versionInfo.dwBuildNumber);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -249,27 +321,34 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2OS.GetXPManifest;
|
||||
begin
|
||||
Result := (FCCVersion.Major >= 6);
|
||||
end;
|
||||
|
||||
|
||||
function TX2OS.FormatVersion;
|
||||
var
|
||||
sBuild: String;
|
||||
|
||||
begin
|
||||
sBuild := '';
|
||||
sBuild := '';
|
||||
|
||||
if Build then
|
||||
sBuild := Format(' build %d', [FVersionEx.Build]);
|
||||
sBuild := Format(' build %d', [FVersionEx.Build]);
|
||||
|
||||
with FVersionEx do
|
||||
Result := Format('%s %s%s', [Name, VersionString, sBuild]);
|
||||
end;
|
||||
|
||||
|
||||
function TX2OS.GetXPManifest;
|
||||
begin
|
||||
Result := (FCCVersion.Major >= 6);
|
||||
end;
|
||||
|
||||
|
||||
function TX2OS.GetSupportsUAC: Boolean;
|
||||
begin
|
||||
Result := (FVersionEx.RawInfo.dwMajorVersion >= 6);
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
finalization
|
||||
FreeAndNil(GOS);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user