Иницилизация расширения файла

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;

{
Beta
}
 
unit AssocUnit;
 
interface
 
uses Windows, Forms, Registry, SysUtils, ComObj, ShlObj;
 
const
  MY_NAME = 'Player'
 
type
  TAssoc = class(TObject)
  private
    FReg: TRegistry;
    FAppAssocReg: IApplicationAssociationRegistration;
  public
    constructor Create;
    destructor Destroy; override;
    procedure RegisterApp;
    function Register(pExt: PChar): Boolean;
    function UnRegister(pExt: PChar): Boolean;
    function IsRegister(pExt: PChar): Boolean;
    procedure UpdateIcon;
  end;
 
implementation
 
constructor TAssoc.Create;
begin
  FReg := TRegistry.Create;
  FAppAssocReg := IApplicationAssociationRegistration
    (CreateComObject(CLSID_ApplicationAssociationRegistration));
end;
 
destructor TAssoc.Destroy;
begin
  FReg.Free;
end;
 
procedure TAssoc.RegisterApp;
var
  sKey: string;
begin
  if Assigned(FAppAssocReg) then
  begin
    sKey := 'Software\Clients\Media\' + MY_NAME + '\Capabilities';
    FReg.RootKey := HKEY_LOCAL_MACHINE;
    if FReg.OpenKey('SOFTWARE\RegisteredApplications', True) then
    begin
      FReg.WriteString(MY_NAME, sKey);
      FReg.CloseKey;
    end;
    if FReg.OpenKey(sKey, True) then
    begin
      FReg.WriteExpandString('ApplicationDescription', MY_NAME);
      FReg.WriteExpandString('ApplicationIcon', '"' + Application.ExeName +
        '"' + ',0');
      FReg.WriteExpandString('ApplicationName', MY_NAME);
      FReg.CloseKey;
    end;
  end;
end;
 
function TAssoc.Register(pExt: PChar): Boolean;
var
  pCurrentAssociation: PChar;
  sID, sCurrentAssociation: string;
begin
  Result := False;
  FReg.RootKey := HKEY_CLASSES_ROOT;
  if not FReg.OpenKey(pExt, True) then
    Exit;
  sID := MY_NAME + pExt;
  if not FReg.OpenKey(sID + '\shell\open', True) then
    Exit;
  FReg.WriteString('', 'Открить в ' + MY_NAME);
  FReg.CloseKey;
  if not FReg.OpenKey(sID + '\shell\open\command', True) then
    Exit;
  FReg.WriteString('', '"' + Application.ExeName + '"' + ' "%1"');
  FReg.CloseKey;
  if not FReg.OpenKey(sID + '\DefaultIcon', True) then
    Exit;
  FReg.WriteString('', '"' + Application.ExeName + '"' + ',0');
  FReg.CloseKey;
  FReg.RootKey := HKEY_LOCAL_MACHINE;
  if not FReg.OpenKey('Software\Clients\Media\' + MY_NAME +
    '\Capabilities\FileAssociations', True) then
    Exit;
  FReg.WriteString(pExt, sID);
  FReg.CloseKey;
  FReg.RootKey := HKEY_CLASSES_ROOT;
  if FAppAssocReg <> nil then
  begin
    if FAppAssocReg.QueryCurrentDefault(pExt, AT_FILEEXTENSION,
      AL_EFFECTIVE, pCurrentAssociation) = 0 then
      sCurrentAssociation := pCurrentAssociation;
    Result := FAppAssocReg.SetAppAsDefault(MY_NAME, pExt,
      AT_FILEEXTENSION) = 0;
  end
  else
  begin
    if FReg.OpenKey(pExt, False) then
    begin
      sCurrentAssociation := FReg.ReadString('');
      FReg.WriteString('', sID);
      FReg.CloseKey;
      Result := True;
    end;
  end;
  if FReg.OpenKey(sID, True) then
  begin
    FReg.WriteString('Backup', pCurrentAssociation);
    FReg.CloseKey;
  end;
end;
 
function TAssoc.UnRegister(pExt: PChar): Boolean;
var
  sID, sBackup: string;
begin
  Result := False;
  sID := MY_NAME + pExt;
  FReg.RootKey := HKEY_CLASSES_ROOT;
  if not FReg.OpenKey(sID, False) then
    Exit;
  sBackup := FReg.ReadString('Backup');
  FReg.CloseKey;
  if not FReg.OpenKey(pExt, False) then
    Exit;
  FReg.WriteString('', sBackup);
  FReg.CloseKey;
  Result := FReg.DeleteKey(sID);
end;
 
function TAssoc.IsRegister(pExt: PChar): Boolean;
var
  b: BOOL;
  sID: string;
begin
  b := False;
  FReg.RootKey := HKEY_CLASSES_ROOT;
  sID := MY_NAME + pExt;
  if FAppAssocReg <> nil then
    FAppAssocReg.QueryAppIsDefault(pExt, AT_FILEEXTENSION, AL_EFFECTIVE,
      MY_NAME, b)
  else
  begin
    if FReg.OpenKey(pExt, False) then
    begin
      b := FReg.ReadString('') = sID;
      FReg.CloseKey;
    end;
  end;
  if b then
  begin
    b := False;
    if FReg.OpenKey(sID + '\shell\open\command', False) then
    begin
      b := Pos(Application.ExeName, FReg.ReadString('')) > 0;
      FReg.CloseKey;
    end;
  end;
  Result := b;
end;
 
procedure TAssoc.UpdateIcon;
begin
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;
 
end.

procedure ApplyAssoc;
var
  Assoc: TAssoc;
begin
  Assoc := TAssoc.Create;
  try
    Assoc.RegisterApp;
    Assoc.Register('.mp3');
    Assoc.UpdateIcon;
  finally
    Assoc.Free;
  end;
end;

procedure ApplyAssoc;
var
  Assoc: TAssoc;
begin
  Assoc := TAssoc.Create;
  try
    Assoc.RegisterApp;
   if not Assoc.IsRegister('.mp3') then
        Assoc.Register('.mp3');
    Assoc.UpdateIcon;
  finally
    Assoc.Free;
  end;
end;