⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 compfileassoc.pas

📁 源代码
💻 PAS
字号:
unit CompFileAssoc;

{
  Inno Setup
  Copyright (C) 1997-2004 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.7 2004/03/03 02:48:32 jr Exp $
}

interface

procedure RegisterISSFileAssociation;
procedure UnregisterISSFileAssociation;

implementation

uses
  Windows, SysUtils, PathFunc, ShlObj, CmnFunc2;

procedure RegisterISSFileAssociation;

  procedure SetKeyValue(const Subkey: PChar; const Data: String);

    procedure Check(const Res: Longint);
    begin
      if Res <> ERROR_SUCCESS then
        raise Exception.CreateFmt('Error creating file association:'#13#10'%d - %s',
          [Res, Win32ErrorString(Res)]);
    end;

  var
    K: HKEY;
    Disp: DWORD;
  begin
    Check(RegCreateKeyEx(HKEY_CLASSES_ROOT, Subkey, 0, nil, 0, KEY_SET_VALUE,
      nil, K, @Disp));
    try
      Check(RegSetValueEx(K, nil, 0, REG_SZ, PChar(Data), Length(Data)+1));
    finally
      RegCloseKey(K);
    end;
  end;

var
  SelfName: String;
begin
  SelfName := ParamStr(0);

  SetKeyValue('.iss', 'InnoSetupScriptFile');

  SetKeyValue('InnoSetupScriptFile', 'Inno Setup Script');
  SetKeyValue('InnoSetupScriptFile\DefaultIcon', SelfName + ',1');
  SetKeyValue('InnoSetupScriptFile\shell\open\command',
    '"' + SelfName + '" "%1"');
  SetKeyValue('InnoSetupScriptFile\shell\OpenWithInnoSetup',
    'Open with &Inno Setup');
  SetKeyValue('InnoSetupScriptFile\shell\OpenWithInnoSetup\command',
    '"' + SelfName + '" "%1"');
  SetKeyValue('InnoSetupScriptFile\shell\Compile', 'Compi&le');
  SetKeyValue('InnoSetupScriptFile\shell\Compile\command',
    '"' + SelfName + '" /cc "%1"');

  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;

procedure UnregisterISSFileAssociation;

  function KeyValueEquals(const Subkey: PChar; const Data: String): Boolean;
  var
    K: HKEY;
    S: String;
  begin
    Result := False;
    if RegOpenKeyEx(HKEY_CLASSES_ROOT, 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;
  var
    K: HKEY;
  begin
    Result := (RegOpenKeyEx(HKEY_CLASSES_ROOT, Subkey, 0, KEY_QUERY_VALUE,
      K) = ERROR_SUCCESS);
    if Result then
      RegCloseKey(K);
  end;

  function GetKeyNumSubkeysValues(const Subkey: PChar;
    var NumSubkeys, NumValues: DWORD): Boolean;
  var
    K: HKEY;
  begin
    Result := False;
    if RegOpenKeyEx(HKEY_CLASSES_ROOT, 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 DeleteDefaultValue(const Subkey: PChar);
  var
    K: HKEY;
  begin
    if RegOpenKeyEx(HKEY_CLASSES_ROOT, Subkey, 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
      RegDeleteValue(K, '');
      RegCloseKey(K);
    end;
  end;

var
  SelfName: String;
  NumSubkeys, NumValues: DWORD;
begin
  if not KeyExists('InnoSetupScriptFile') and not KeyExists('.iss') then
    Exit;

  SelfName := ParamStr(0);

  { NOTE: We can't just blindly delete the entire .iss & InnoSetupScriptFile
    keys, otherwise we'd remove the association even if we weren't the one who
    registered it in the first place. }

  { Clean up 'InnoSetupScriptFile' }
  if KeyValueEquals('InnoSetupScriptFile\DefaultIcon', SelfName + ',1') then
    RegDeleteKeyIncludingSubkeys(HKEY_CLASSES_ROOT, 'InnoSetupScriptFile\DefaultIcon');
  if KeyValueEquals('InnoSetupScriptFile\shell\open\command', '"' + SelfName + '" "%1"') then
    RegDeleteKeyIncludingSubkeys(HKEY_CLASSES_ROOT, 'InnoSetupScriptFile\shell\open');
  if KeyValueEquals('InnoSetupScriptFile\shell\OpenWithInnoSetup\command', '"' + SelfName + '" "%1"') then
    RegDeleteKeyIncludingSubkeys(HKEY_CLASSES_ROOT, 'InnoSetupScriptFile\shell\OpenWithInnoSetup');
  if KeyValueEquals('InnoSetupScriptFile\shell\Compile\command', '"' + SelfName + '" /cc "%1"') then
    RegDeleteKeyIncludingSubkeys(HKEY_CLASSES_ROOT, 'InnoSetupScriptFile\shell\Compile');
  RegDeleteKeyIfEmpty(HKEY_CLASSES_ROOT, 'InnoSetupScriptFile\shell');
  if KeyValueEquals('InnoSetupScriptFile', 'Inno Setup Script') and
     GetKeyNumSubkeysValues('InnoSetupScriptFile', NumSubkeys, NumValues) and
     (NumSubkeys = 0) and (NumValues <= 1) then
    RegDeleteKey(HKEY_CLASSES_ROOT, 'InnoSetupScriptFile');

  { Clean up '.iss' }
  if not KeyExists('InnoSetupScriptFile') and
     KeyValueEquals('.iss', 'InnoSetupScriptFile') then
    DeleteDefaultValue('.iss');
  RegDeleteKeyIfEmpty(HKEY_CLASSES_ROOT, '.iss');

  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -