Added: X2UtOS now supports Windows 7 and Server 2008

Added: X2UtElevation unit for writing UAC compatible applications

Packages/D2007/X2Utils.dpk

@@ -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.

Packages/D2007/X2Utils.dproj

@@ -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>

X2UtElevation.pas

@@ -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.

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 GetVersion; virtual;
-    procedure GetCCVersion(); virtual;
+    procedure GetCCVersion; virtual;
   public
-    constructor Create();
+    constructor Create;
-    destructor Destroy(); override;
+    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,8 +105,30 @@ 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
   SysUtils;
@@ -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();
+  FVersionEx  := TX2OSVersionEx.Create;
-  GetVersion();
+  GetVersion;
-  GetCCVersion();
+  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);
+  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
   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';
+      osWin95:          VersionString := '95';
-      osWin98:      VersionString := '98';
+      osWin98:          VersionString := '98';
-      osWinME:      VersionString := 'ME';
+      osWinME:          VersionString := 'ME';
-      osWinNT3:     VersionString := 'NT 3.51';
+      osWinNT3:         VersionString := 'NT 3.51';
-      osWinNT4:     VersionString := 'NT 4';
+      osWinNT4:         VersionString := 'NT 4';
-      osWin2K:      VersionString := '2000';
+      osWin2K:          VersionString := '2000';
-      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;
 
-    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:
-        Build := pVersion.dwBuildNumber;
+        Build := versionInfo.dwBuildNumber;
       VER_PLATFORM_WIN32_WINDOWS:
-        Build := LoWord(pVersion.dwBuildNumber);
+        Build := LoWord(versionInfo.dwBuildNumber);
     end;
   end;
 end;
@@ -234,7 +306,7 @@ begin
     begin
       FillChar(viVersion, SizeOf(viVersion), #0);
       viVersion.cbSize  := SizeOf(viVersion);
-      
+
       DllGetVersion(@viVersion);
 
       with FCCVersion do
@@ -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);