IDE.FileAssocFunc.pas 5.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163
  1. unit IDE.FileAssocFunc;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2024 Jordan Russell
  5. Portions by Martijn Laan
  6. For conditions of distribution and use, see LICENSE.TXT.
  7. Compiler IDE's functions for registering/unregistering the .iss file association
  8. }
  9. interface
  10. function RegisterISSFileAssociation(const AllowInteractive: Boolean; var AllUsers: Boolean): Boolean;
  11. procedure UnregisterISSFileAssociation(const Conditional: Boolean);
  12. implementation
  13. uses
  14. Windows, SysUtils, ShlObj,
  15. PathFunc, UnsignedFunc,
  16. Shared.CommonFunc.Vcl, Shared.CommonFunc;
  17. function GetRootkey: HKEY;
  18. begin
  19. if IsAdminLoggedOn then
  20. Result := HKEY_LOCAL_MACHINE
  21. else
  22. Result := HKEY_CURRENT_USER;
  23. end;
  24. procedure UnregisterISSFileAssociationDo(const Rootkey: HKEY;
  25. const Conditional: Boolean); forward;
  26. function RegisterISSFileAssociation(const AllowInteractive: Boolean; var AllUsers: Boolean): Boolean;
  27. procedure SetKeyValue(const Rootkey: HKEY; const Subkey, ValueName: PChar; const Data: String);
  28. procedure Check(const Res: DWORD);
  29. begin
  30. if Res <> ERROR_SUCCESS then
  31. raise Exception.CreateFmt('Error creating file association:'#13#10'%d - %s',
  32. [Res, Win32ErrorString(Res)]);
  33. end;
  34. var
  35. K: HKEY;
  36. Disp: DWORD;
  37. begin
  38. Check(DWORD(RegCreateKeyExView(rvDefault, Rootkey, Subkey, 0, nil, 0, KEY_SET_VALUE,
  39. nil, K, @Disp)));
  40. try
  41. Check(DWORD(RegSetValueEx(K, ValueName, 0, REG_SZ, PChar(Data), (ULength(Data)+1)*SizeOf(Data[1]))));
  42. finally
  43. RegCloseKey(K);
  44. end;
  45. end;
  46. var
  47. SelfName: String;
  48. Rootkey: HKEY;
  49. begin
  50. Rootkey := GetRootkey;
  51. AllUsers := Rootkey = HKEY_LOCAL_MACHINE;
  52. Result := AllUsers or not AllowInteractive or
  53. (MsgBox('Unable to associate for all users without administrative privileges. Do you want to associate only for yourself instead?',
  54. 'Associate', mbConfirmation, MB_YESNO) = IDYES);
  55. if not Result then
  56. Exit;
  57. { Remove any cruft left around from an older/newer version }
  58. UnregisterISSFileAssociationDo(Rootkey, False);
  59. SelfName := NewParamStr(0);
  60. SetKeyValue(Rootkey, 'Software\Classes\.iss', nil, 'InnoSetupScriptFile');
  61. SetKeyValue(Rootkey, 'Software\Classes\.iss', 'Content Type', 'text/plain');
  62. SetKeyValue(Rootkey, 'Software\Classes\.iss\OpenWithProgids', 'InnoSetupScriptFile', '');
  63. SetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile', nil, 'Inno Setup Script');
  64. SetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile\DefaultIcon', nil, SelfName + ',1');
  65. SetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\open\command', nil,
  66. '"' + SelfName + '" "%1"');
  67. SetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\Compile', nil, 'Compi&le');
  68. SetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\Compile\command', nil,
  69. '"' + SelfName + '" /cc "%1"');
  70. { If we just associated for all users, remove our existing association for the current user if it exists. }
  71. if AllUsers then
  72. UnregisterISSFileAssociationDo(HKEY_CURRENT_USER, False);
  73. SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
  74. end;
  75. procedure UnregisterISSFileAssociationDo(const Rootkey: HKEY;
  76. const Conditional: Boolean);
  77. { If Conditional is True, no action is taken if the association exists but
  78. doesn't point to the currently-running EXE file. That can happen when there
  79. are multiple Inno Setup installations in different paths. When one of them
  80. is uninstalled, the association shouldn't be unregistered if a different
  81. installation currently "owns" it. }
  82. function GetKeyValue(const Rootkey: HKEY; const Subkey: PChar;
  83. var Data: String): Boolean;
  84. var
  85. K: HKEY;
  86. begin
  87. Result := False;
  88. if RegOpenKeyExView(rvDefault, Rootkey, Subkey, 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
  89. if RegQueryStringValue(K, nil, Data) then
  90. Result := True;
  91. RegCloseKey(K);
  92. end;
  93. end;
  94. procedure DeleteValue(const Rootkey: HKEY; const Subkey, ValueName: PChar);
  95. var
  96. K: HKEY;
  97. begin
  98. if RegOpenKeyExView(rvDefault, Rootkey, Subkey, 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
  99. RegDeleteValue(K, ValueName);
  100. RegCloseKey(K);
  101. end;
  102. end;
  103. begin
  104. if Conditional then begin
  105. const ExpectedCommand = '"' + NewParamStr(0) + '" "%1"';
  106. var CurCommand: String;
  107. if GetKeyValue(Rootkey, 'Software\Classes\InnoSetupScriptFile\shell\open\command', CurCommand) and
  108. (PathCompare(CurCommand, ExpectedCommand) <> 0) then
  109. Exit;
  110. end;
  111. { Remove 'InnoSetupScriptFile' entirely. We own it. }
  112. RegDeleteKeyIncludingSubkeys(rvDefault, Rootkey,
  113. 'Software\Classes\InnoSetupScriptFile');
  114. { As for '.iss', remove only our OpenWithProgids value, not the whole key.
  115. Other apps may have added their own OpenWithProgids values there, and
  116. Microsoft docs recommend against trying to delete the key's default value
  117. (which points to a ProgID). See:
  118. https://learn.microsoft.com/en-us/windows/win32/shell/fa-file-types
  119. }
  120. DeleteValue(Rootkey, 'Software\Classes\.iss\OpenWithProgids',
  121. 'InnoSetupScriptFile');
  122. { Remove unnecessary key set by previous versions }
  123. RegDeleteKeyIncludingSubkeys(rvDefault, Rootkey,
  124. 'Software\Classes\Applications\Compil32.exe');
  125. end;
  126. procedure UnregisterISSFileAssociation(const Conditional: Boolean);
  127. begin
  128. UnregisterISSFileAssociationDo(HKEY_CURRENT_USER, Conditional);
  129. if IsAdminLoggedOn then
  130. UnregisterISSFileAssociationDo(HKEY_LOCAL_MACHINE, Conditional);
  131. SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
  132. end;
  133. end.