IDE.FileAssocFunc.pas 5.6 KB

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