LocalIfGLobalFails property for X2UtSingleInstance

VistaMan units; like XPMan but with various requested privilege levels

Packages/D2007/X2Utils.dproj

@@ -5,7 +5,7 @@
     <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
     <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
     <DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
-    <DCC_DependencyCheckOutputName>..\..\..\..\bin\D2007\X2Utils2007.bpl</DCC_DependencyCheckOutputName>
+    <DCC_DependencyCheckOutputName>..\..\..\bpl\D2006\X2Utils2007.bpl</DCC_DependencyCheckOutputName>
   </PropertyGroup>
   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
     <Version>7.0</Version>
@@ -33,6 +33,16 @@
 <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>
@@ -42,12 +52,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="..\..\..\..\rtl.dcp" />
-    <DCCReference Include="..\..\..\..\vcl.dcp" />
-    <DCCReference Include="..\..\..\..\vclx.dcp" />
     <DCCReference Include="..\..\X2UtApp.pas" />
     <DCCReference Include="..\..\X2UtBits.pas" />
     <DCCReference Include="..\..\X2UtGraphics.pas" />

Resources/VistaManAsInvoker.manifest

@@ -0,0 +1,24 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+  <dependency>
+    <dependentAssembly>
+      <assemblyIdentity
+        type="win32"
+	name="Microsoft.Windows.Common-Controls"
+	version="6.0.0.0"
+	publicKeyToken="6595b64144ccf1df"
+	language="*"
+	processorArchitecture="x86" />
+    </dependentAssembly>
+  </dependency>
+
+  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
+    <security>
+      <requestedPrivileges>
+        <requestedExecutionLevel
+	  level="asInvoker"/>
+      </requestedPrivileges>
+    </security>
+  </trustInfo>
+</assembly>

Resources/VistaManAsInvoker.rc

@@ -0,0 +1 @@
+1 24 "VistaManAsInvoker.manifest"

Resources/VistaManHighestAvailable.manifest

@@ -0,0 +1,24 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+  <dependency>
+    <dependentAssembly>
+      <assemblyIdentity
+        type="win32"
+	name="Microsoft.Windows.Common-Controls"
+	version="6.0.0.0"
+	publicKeyToken="6595b64144ccf1df"
+	language="*"
+	processorArchitecture="x86" />
+    </dependentAssembly>
+  </dependency>
+
+  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
+    <security>
+      <requestedPrivileges>
+        <requestedExecutionLevel
+	  level="highestAvailable"/>
+      </requestedPrivileges>
+    </security>
+  </trustInfo>
+</assembly>

Resources/VistaManHighestAvailable.rc

@@ -0,0 +1 @@
+1 24 "VistaManHighestAvailable.manifest"

Resources/VistaManRequireAdministrator.manifest

@@ -0,0 +1,24 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+  <dependency>
+    <dependentAssembly>
+      <assemblyIdentity
+        type="win32"
+	name="Microsoft.Windows.Common-Controls"
+	version="6.0.0.0"
+	publicKeyToken="6595b64144ccf1df"
+	language="*"
+	processorArchitecture="x86" />
+    </dependentAssembly>
+  </dependency>
+
+  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
+    <security>
+      <requestedPrivileges>
+        <requestedExecutionLevel
+	  level="requireAdministrator"/>
+      </requestedPrivileges>
+    </security>
+  </trustInfo>
+</assembly>

Resources/VistaManRequireAdministrator.rc

@@ -0,0 +1 @@
+1 24 "VistaManRequireAdministrator.manifest"

VistaManAsInvoker.pas

@@ -0,0 +1,11 @@
+unit VistaManAsInvoker;
+
+{$WEAKPACKAGEUNIT ON}
+
+interface
+
+{$R 'Resources\VistaManAsInvoker.RES'}
+
+implementation
+end.
+

VistaManHighestAvailable.pas

@@ -0,0 +1,11 @@
+unit VistaManHighestAvailable;
+
+{$WEAKPACKAGEUNIT ON}
+
+interface
+
+{$R 'Resources\VistaManHighestAvailable.RES'}
+
+implementation
+end.
+

VistaManRequireAdministrator.pas

@@ -0,0 +1,11 @@
+unit VistaManRequireAdministrator;
+
+{$WEAKPACKAGEUNIT ON}
+
+interface
+
+{$R 'Resources\VistaManRequireAdministrator.RES'}
+
+implementation
+end.
+

X2UtApp.pas

@@ -452,7 +452,7 @@ end;
 function TX2App.FormatVersion(const ABuild: Boolean = True;
                               const AProductName: Boolean = False): String;
 begin
-  Result  := FVersion.FormatVersion(ABuild, AProductName);
+  Result  := Version.FormatVersion(ABuild, AProductName);
 end;
 
 

X2UtSingleInstance.pas

@@ -72,11 +72,13 @@ type
     FFileMapData:       PX2InstanceMapData;
     FFileMapping:       THandle;
     FObservers:         TInterfaceList;
+    FLocalIfGlobalFails: Boolean;
   protected
     function GetCount(): Integer; virtual;
+    procedure SetActive(const Value: Boolean); virtual;
     procedure SetApplicationID(const Value: String); virtual;
     procedure SetGlobal(const Value: Boolean); virtual;
-    procedure SetActive(const Value: Boolean); virtual;
+    procedure SetLocalIfGlobalFails(const Value: Boolean); virtual;
 
     procedure WindowProc(var Message: TMessage); virtual;
 
@@ -104,11 +106,12 @@ type
     //:$ Unregisters a previously registered instance.
     procedure Detach(const ANotifier: IX2InstanceObserver);
 
-    property Active:          Boolean   read FActive          write SetActive;
+    property Active:              Boolean   read FActive              write SetActive;
-    property ApplicationID:   String    read FApplicationID   write SetApplicationID;
+    property ApplicationID:       String    read FApplicationID       write SetApplicationID;
-    property FirstInstance:   Boolean   read FFirstInstance;
+    property FirstInstance:       Boolean   read FFirstInstance;
-    property Global:          Boolean   read FGlobal          write SetGlobal;
+    property Global:              Boolean   read FGlobal              write SetGlobal;
-    property Count:           Integer   read GetCount;
+    property LocalIfGlobalFails:  Boolean   read FLocalIfGlobalFails  write SetLocalIfGlobalFails;
+    property Count:               Integer   read GetCount;
   end;
 
   {
@@ -217,6 +220,7 @@ begin
   inherited;
 
   FObservers  := TInterfaceList.Create;
+  FLocalIfGlobalFails := True;
 end;
 
 destructor TX2Instance.Destroy();
@@ -299,7 +303,15 @@ begin
                                      PChar(ScopePrefix[Global] +
                                            'SingleInstance.' + ApplicationID));
   if FFileMapping = 0 then
-    RaiseLastOSError();
+  begin
+    if Global and LocalIfGlobalFails then
+    begin
+      FGlobal := False;
+      Open();
+      Exit;
+    end else
+      RaiseLastOSError();
+  end;
 
   FActive := True;
   try
@@ -442,6 +454,11 @@ begin
 end;
 
 
+procedure TX2Instance.SetLocalIfGlobalFails(const Value: Boolean);
+begin
+  FLocalIfGlobalFails := Value;
+end;
+
 
 // Copied from System unit because Borland didn't make it public
 function GetParamStr(P: PChar; var Param: String): PChar;