Delphi модуль ассоциации файлов

unit FileAssociation;
 
// модуль ассоциации файлов
 
interface
 
uses Windows, SysUtils, Registry, ShlObj;
 
procedure FileAssociate(const Ext, progName: string; Icon: string = ''; ProgPath: string = '');
procedure FileUnAssociate(const Ext, progName:string);
 
implementation
 
procedure FileAssociate(const Ext, progName: string; Icon: string = ''; ProgPath: string = '');
var r: TRegistry;
begin
  r:=TRegistry.Create;
  r.RootKey:=HKEY_CURRENT_USER;
  r.OpenKey('Software\Classes\.'+UpperCase(Ext),true);
  r.WriteString('',progName);
    r.CloseKey;
  r.OpenKey('Software\Classes\'+progName+'\shell\open\command',true);
  if ProgPath='' then
     r.WriteString('','"'+ParamStr(0)+'" "%1"')
  else
     r.WriteString('','"'+ProgPath+'" "%1"');
  r.CloseKey;
  if Icon<>'' then begin
    r.OpenKey('Software\Classes\'+progName+'\DefaultIcon',true);
    r.WriteString('',Icon);
    r.CloseKey;
  end;
  r.Free;
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;
 
procedure FileUnAssociate(const Ext, progName:string);
var r: TRegistry;
begin
  r:=TRegistry.Create;
  r.RootKey:=HKEY_CURRENT_USER;
  if r.OpenKey('Software\Classes\'+progName,false) then begin
    r.CloseKey;
    r.DeleteKey('Software\Classes\'+progName);
  end;
  if r.OpenKey('Software\Classes\.'+UpperCase(Ext),false) and
     (r.ReadString('') = progName) then begin
     r.CloseKey;
     r.DeleteKey('Software\Classes\.'+UpperCase(Ext));
  end;
  r.Free;
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;
 
 
end.