Delphi 注册(关联)指定的扩展名

(*
注册(关联)指定的扩展名
*)

unit xRegExt;

interface
uses
  Registry, shlobj, Windows;

/// <summary>
/// 获取指定扩展名的打开程序
/// </summary>
function GetExeByExtension(sExt : string) : string;
/// <summary>
/// 注册(关联)指定的扩展名
/// </summary>
/// <param name="ExtName">扩展名(不含".")</param>
/// <param name="AppName">程序名称</param>
procedure RegisterFileType(ExtName:String; AppName:String) ;

implementation

function GetExeByExtension(sExt : string) : string;
var
   sExtDesc:string;
begin
   with TRegistry.Create do
   begin
     try
       RootKey:=HKEY_CLASSES_ROOT;
       if OpenKeyReadOnly(sExt) then
       begin
         sExtDesc:=ReadString('') ;
         CloseKey;
       end;
       if sExtDesc <>'' then
       begin
         if OpenKeyReadOnly(sExtDesc + '/Shell/Open/Command') then
         begin
           Result:= ReadString('') ;
         end
       end;
     finally
       Free;
     end;
   end;

   if Result <> '' then
   begin
     if Result[1] = '"' then
     begin
       Result:=Copy(Result,2,-1 + Pos('"',Copy(Result,2,MaxINt))) ;
     end
   end;
end;

procedure RegisterFileType(ExtName:String; AppName:String) ;
var
  reg:TRegistry;
begin
  reg := TRegistry.Create;
  try
   reg.RootKey:=HKEY_CLASSES_ROOT;
   reg.OpenKey('.' + ExtName, True) ;
   reg.WriteString('', ExtName + 'file') ;
   reg.CloseKey;
   reg.CreateKey(ExtName + 'file') ;
   reg.OpenKey(ExtName + 'file\DefaultIcon', True) ;
   reg.WriteString('', AppName + ',0') ;
   reg.CloseKey;
   reg.OpenKey(ExtName + 'file\shell\open\command', True) ;
   reg.WriteString('',AppName+' "%1"') ;
   reg.CloseKey;
  finally
   reg.Free;
  end;

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