Browse Source

The Compiler IDE Options button Associate .iss files with this compiler can now associate for the current user instead of displaying an error if administrative privileges are not available.

Martijn Laan 7 years ago
parent
commit
b09ec647bb
4 changed files with 83 additions and 49 deletions
  1. 73 45
      Projects/CompFileAssoc.pas
  2. 7 3
      Projects/CompOptions.pas
  3. 2 1
      Projects/Compil32.dpr
  4. 1 0
      whatsnew.htm

+ 73 - 45
Projects/CompFileAssoc.pas

@@ -2,28 +2,36 @@ unit CompFileAssoc;
 
 {
   Inno Setup
-  Copyright (C) 1997-2005 Jordan Russell
+  Copyright (C) 1997-2018 Jordan Russell
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
 
   Functions for registering/unregistering the .iss file association
-
-  $jrsoftware: issrc/Projects/CompFileAssoc.pas,v 1.13 2009/04/21 13:46:04 mlaan Exp $
 }
 
 interface
 
-procedure RegisterISSFileAssociation;
+function RegisterISSFileAssociation(const AllowInteractive: Boolean; var AllUsers: Boolean): Boolean;
 procedure UnregisterISSFileAssociation;
 
 implementation
 
 uses
-  Windows, SysUtils, PathFunc, ShlObj, CmnFunc2;
+  Windows, SysUtils, PathFunc, ShlObj, CmnFunc, CmnFunc2;
+  
+function GetRootkey: HKEY;
+begin
+  if IsAdminLoggedOn then
+    Result := HKEY_LOCAL_MACHINE
+  else
+    Result := HKEY_CURRENT_USER;
+end;
+
+procedure UnregisterISSFileAssociationDo(const Rootkey: HKEY; const ChangeNotify: Boolean); forward;
 
-procedure RegisterISSFileAssociation;
+function RegisterISSFileAssociation(const AllowInteractive: Boolean; var AllUsers: Boolean): Boolean;
 
-  procedure SetKeyValue(const Subkey, ValueName: PChar; const Data: String);
+  procedure SetKeyValue(const Rootkey: HKEY; const Subkey, ValueName: PChar; const Data: String);
 
     procedure Check(const Res: Longint);
     begin
@@ -36,7 +44,7 @@ procedure RegisterISSFileAssociation;
     K: HKEY;
     Disp: DWORD;
   begin
-    Check(RegCreateKeyExView(rvDefault, HKEY_CLASSES_ROOT, Subkey, 0, nil, 0, KEY_SET_VALUE,
+    Check(RegCreateKeyExView(rvDefault, Rootkey, Subkey, 0, nil, 0, KEY_SET_VALUE,
       nil, K, @Disp));
     try
       Check(RegSetValueEx(K, ValueName, 0, REG_SZ, PChar(Data), (Length(Data)+1)*SizeOf(Data[1])));
@@ -47,70 +55,84 @@ procedure RegisterISSFileAssociation;
 
 var
   SelfName: String;
+  Rootkey: HKEY;
 begin
+  Rootkey := GetRootkey;
+  AllUsers := Rootkey = HKEY_LOCAL_MACHINE;
+  
+  Result := AllUsers or not AllowInteractive or
+            (MsgBox('Unable to associate for all users without administrative privileges. Do you want to associate only for yourself instead?',
+              'Associate', mbConfirmation, MB_YESNO) = IDYES);
+  if not Result then
+    Exit;
+
   SelfName := NewParamStr(0);
 
-  SetKeyValue('.iss', nil, 'InnoSetupScriptFile');
-  SetKeyValue('.iss', 'Content Type', 'text/plain');
+  SetKeyValue(Rootkey, 'Software\Classes\.iss', nil, 'InnoSetupScriptFile');
+  SetKeyValue(Rootkey, 'Software\Classes\.iss', 'Content Type', 'text/plain');
 
-  SetKeyValue('InnoSetupScriptFile', nil, 'Inno Setup Script');
-  SetKeyValue('InnoSetupScriptFile\DefaultIcon', nil, SelfName + ',1');
-  SetKeyValue('InnoSetupScriptFile\shell\open\command', nil,
+  SetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile', nil, 'Inno Setup Script');
+  SetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile\DefaultIcon', nil, SelfName + ',1');
+  SetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\open\command', nil,
     '"' + SelfName + '" "%1"');
-  SetKeyValue('InnoSetupScriptFile\shell\OpenWithInnoSetup', nil,
+  SetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\OpenWithInnoSetup', nil,
     'Open with &Inno Setup');
-  SetKeyValue('InnoSetupScriptFile\shell\OpenWithInnoSetup\command', nil,
+  SetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\OpenWithInnoSetup\command', nil,
     '"' + SelfName + '" "%1"');
-  SetKeyValue('InnoSetupScriptFile\shell\Compile', nil, 'Compi&le');
-  SetKeyValue('InnoSetupScriptFile\shell\Compile\command', nil,
+  SetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\Compile', nil, 'Compi&le');
+  SetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\Compile\command', nil,
     '"' + SelfName + '" /cc "%1"');
 
+  { If we just associated for all users, remove our existing association for the current user if it exists. }
+  if AllUsers then
+    UnregisterISSFileAssociationDo(HKEY_CURRENT_USER, False);
+
   SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
 end;
 
-procedure UnregisterISSFileAssociation;
+procedure UnregisterISSFileAssociationDo(const Rootkey: HKEY; const ChangeNotify: Boolean);
 
-  function KeyValueEquals(const Subkey: PChar; const Data: String): Boolean;
+  function KeyValueEquals(const Rootkey: HKEY; const Subkey: PChar; const Data: String): Boolean;
   var
     K: HKEY;
     S: String;
   begin
     Result := False;
-    if RegOpenKeyExView(rvDefault, HKEY_CLASSES_ROOT, Subkey, 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
+    if RegOpenKeyExView(rvDefault, Rootkey, Subkey, 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
       if RegQueryStringValue(K, nil, S) and (PathCompare(Data, S) = 0) then
         Result := True;
       RegCloseKey(K);
     end;
   end;
 
-  function KeyExists(const Subkey: PChar): Boolean;
+  function KeyExists(const Rootkey: HKEY; const Subkey: PChar): Boolean;
   var
     K: HKEY;
   begin
-    Result := (RegOpenKeyExView(rvDefault, HKEY_CLASSES_ROOT, Subkey, 0, KEY_QUERY_VALUE,
+    Result := (RegOpenKeyExView(rvDefault, Rootkey, Subkey, 0, KEY_QUERY_VALUE,
       K) = ERROR_SUCCESS);
     if Result then
       RegCloseKey(K);
   end;
 
-  function GetKeyNumSubkeysValues(const Subkey: PChar;
+  function GetKeyNumSubkeysValues(const Rootkey: HKEY; const Subkey: PChar;
     var NumSubkeys, NumValues: DWORD): Boolean;
   var
     K: HKEY;
   begin
     Result := False;
-    if RegOpenKeyExView(rvDefault, HKEY_CLASSES_ROOT, Subkey, 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
+    if RegOpenKeyExView(rvDefault, Rootkey, Subkey, 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
       Result := RegQueryInfoKey(K, nil, nil, nil, @NumSubkeys, nil, nil,
         @NumValues, nil, nil, nil, nil) = ERROR_SUCCESS;
       RegCloseKey(K);
     end;
   end;
 
-  procedure DeleteValue(const Subkey, ValueName: PChar);
+  procedure DeleteValue(const Rootkey: HKEY; const Subkey, ValueName: PChar);
   var
     K: HKEY;
   begin
-    if RegOpenKeyExView(rvDefault, HKEY_CLASSES_ROOT, Subkey, 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
+    if RegOpenKeyExView(rvDefault, Rootkey, Subkey, 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
       RegDeleteValue(K, ValueName);
       RegCloseKey(K);
     end;
@@ -120,7 +142,7 @@ var
   SelfName: String;
   NumSubkeys, NumValues: DWORD;
 begin
-  if not KeyExists('InnoSetupScriptFile') and not KeyExists('.iss') then
+  if not KeyExists(Rootkey, 'Software\Classes\InnoSetupScriptFile') and not KeyExists(Rootkey, 'Software\Classes\.iss') then
     Exit;
 
   SelfName := NewParamStr(0);
@@ -130,29 +152,35 @@ begin
     registered it in the first place. }
 
   { Clean up 'InnoSetupScriptFile' }
-  if KeyValueEquals('InnoSetupScriptFile\DefaultIcon', SelfName + ',1') then
-    RegDeleteKeyIncludingSubkeys(rvDefault, HKEY_CLASSES_ROOT, 'InnoSetupScriptFile\DefaultIcon');
-  if KeyValueEquals('InnoSetupScriptFile\shell\open\command', '"' + SelfName + '" "%1"') then
-    RegDeleteKeyIncludingSubkeys(rvDefault, HKEY_CLASSES_ROOT, 'InnoSetupScriptFile\shell\open');
-  if KeyValueEquals('InnoSetupScriptFile\shell\OpenWithInnoSetup\command', '"' + SelfName + '" "%1"') then
-    RegDeleteKeyIncludingSubkeys(rvDefault, HKEY_CLASSES_ROOT, 'InnoSetupScriptFile\shell\OpenWithInnoSetup');
-  if KeyValueEquals('InnoSetupScriptFile\shell\Compile\command', '"' + SelfName + '" /cc "%1"') then
-    RegDeleteKeyIncludingSubkeys(rvDefault, HKEY_CLASSES_ROOT, 'InnoSetupScriptFile\shell\Compile');
-  RegDeleteKeyIfEmpty(rvDefault, HKEY_CLASSES_ROOT, 'InnoSetupScriptFile\shell');
-  if KeyValueEquals('InnoSetupScriptFile', 'Inno Setup Script') and
-     GetKeyNumSubkeysValues('InnoSetupScriptFile', NumSubkeys, NumValues) and
+  if KeyValueEquals(Rootkey, 'Software\Classes\InnoSetupScriptFile\DefaultIcon', SelfName + ',1') then
+    RegDeleteKeyIncludingSubkeys(rvDefault, Rootkey, 'Software\Classes\InnoSetupScriptFile\DefaultIcon');
+  if KeyValueEquals(Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\open\command', '"' + SelfName + '" "%1"') then
+    RegDeleteKeyIncludingSubkeys(rvDefault, Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\open');
+  if KeyValueEquals(Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\OpenWithInnoSetup\command', '"' + SelfName + '" "%1"') then
+    RegDeleteKeyIncludingSubkeys(rvDefault, Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\OpenWithInnoSetup');
+  if KeyValueEquals(Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\Compile\command', '"' + SelfName + '" /cc "%1"') then
+    RegDeleteKeyIncludingSubkeys(rvDefault, Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\Compile');
+  RegDeleteKeyIfEmpty(rvDefault, Rootkey, 'Software\Classes\InnoSetupScriptFile\shell');
+  if KeyValueEquals(Rootkey, 'Software\Classes\InnoSetupScriptFile', 'Inno Setup Script') and
+     GetKeyNumSubkeysValues(Rootkey, 'Software\Classes\InnoSetupScriptFile', NumSubkeys, NumValues) and
      (NumSubkeys = 0) and (NumValues <= 1) then
-    RegDeleteKey(HKEY_CLASSES_ROOT, 'InnoSetupScriptFile');
+    RegDeleteKey(Rootkey, 'Software\Classes\InnoSetupScriptFile');
 
   { Clean up '.iss' }
-  if not KeyExists('InnoSetupScriptFile') and
-     KeyValueEquals('.iss', 'InnoSetupScriptFile') then begin
-    DeleteValue('.iss', nil);
-    DeleteValue('.iss', 'Content Type');
+  if not KeyExists(Rootkey, 'Software\Classes\InnoSetupScriptFile') and
+     KeyValueEquals(Rootkey, 'Software\Classes\.iss', 'InnoSetupScriptFile') then begin
+    DeleteValue(Rootkey, 'Software\Classes\.iss', nil);
+    DeleteValue(Rootkey, 'Software\Classes\.iss', 'Content Type');
   end;
-  RegDeleteKeyIfEmpty(rvDefault, HKEY_CLASSES_ROOT, '.iss');
+  RegDeleteKeyIfEmpty(rvDefault, RootKey, 'Software\Classes\.iss');
 
-  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
+  if ChangeNotify then
+    SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
+end;
+
+procedure UnregisterISSFileAssociation;
+begin
+  UnregisterISSFileAssociationDo(GetRootkey, True);
 end;
 
 end.

+ 7 - 3
Projects/CompOptions.pas

@@ -81,10 +81,14 @@ begin
 end;
 
 procedure TOptionsForm.AssocButtonClick(Sender: TObject);
+const
+  UserStrings: array [Boolean] of String = ('the current user', 'all users');
+var
+  AllUsers: Boolean;
 begin
-  RegisterISSFileAssociation;
-  MsgBox('The .iss extension was successfully associated with:'#13#10 + NewParamStr(0),
-    'Associate', mbInformation, MB_OK);
+  if RegisterISSFileAssociation(True, AllUsers) then
+    MsgBox('The .iss extension was successfully associated for ' + UserStrings[AllUsers] + ' with:'#13#10 + NewParamStr(0),
+      'Associate', mbInformation, MB_OK);
 end;
 
 procedure TOptionsForm.ChangeFontButtonClick(Sender: TObject);

+ 2 - 1
Projects/Compil32.dpr

@@ -117,6 +117,7 @@ procedure CheckParams;
 var
   P, I: Integer;
   S: String;
+  Dummy: Boolean;
 begin
   P := NewParamCount;
   I := 1;
@@ -133,7 +134,7 @@ begin
     end
     else if CompareText(S, '/ASSOC') = 0 then begin
       try
-        RegisterISSFileAssociation;
+        RegisterISSFileAssociation(False, Dummy);
       except
         MessageBox(0, PChar(GetExceptMessage), nil, MB_OK or MB_ICONSTOP);
         Halt(2);

+ 1 - 0
whatsnew.htm

@@ -29,6 +29,7 @@ For conditions of distribution and use, see <a href="http://www.jrsoftware.org/f
 <p><a name="5.6.2"></a><span class="ver">5.6.2 </span><span class="date">(?)</span></p>
 <ul>
 <li>Added new [Setup] section directive: <tt>VersionInfoOriginalFileName</tt>, which sets the original filename version value.</li>
+<li>The Compiler IDE Options button <i>Associate .iss files with this compiler</i> can now associate for the current user instead of displaying an error if administrative privileges are not available.</li>
 <li>Pascal Scripting changes:
 <ul>
   <li>Added new special-purpose <i>HelpTextNote</i> message that can be used to specify one or more lines of text that are added to the list of parameters in the summary shown when passing /HELP on the command line.</li>