unit unitFrmMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, registry,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
//參數(shù)說明:
//ft:文件名后綴，如可以為'.tst'或'afile.tst'
//key:在注冊表中的鍵值，要唯一
//desc:關(guān)聯(lián)程序的描述
//icon:缺省的程序圖標，如Application.ExeName+',1'，可以缺省
//prg:對應(yīng)的應(yīng)用程序

procedure registerfiletype(ft, key, desc, icon, prg: string);
var myreg: treginifile;
  ct: integer;
begin

  // 取文件的后綴
  ct := pos('.', ft);
  while ct > 0 do begin
    delete(ft, ct, 1);
    ct := pos('.', ft);
  end;
  if (ft = '') or (prg = '') then exit; //判斷后綴及應(yīng)用程序是否有效
  ft := '.' + ft;
  myreg := treginifile.create('');
  try
    myreg.rootkey := hkey_classes_root; // 根應(yīng)該為HKEY_CLASSES_ROOT
    if key = '' then key := copy(ft, 2, maxint) + '_auto_file';
    // 如果沒給出鍵值，則自動創(chuàng)建一個
    myreg.writestring(ft, '', key); // 寫入描述的鍵值
    myreg.writestring(key, '', desc); // 寫入描述
    if icon <> '' then
      myreg.writestring(key + '\DefaultIcon', '', icon);
    // 寫入缺省圖標
    myreg.writestring(key + '\shell\open\command', '', prg + ' "%1"');
    //寫入相關(guān)聯(lián)的應(yīng)用程序
  finally
    myreg.free;
  end;
end;

//指定本程序和擴展名為TST的文件關(guān)聯(lián)
procedure TForm1.Button1Click(Sender: TObject);
begin
  registerFileType('.tes', 'testfile', '測試關(guān)聯(lián)文件', Application.ExeName + ',1', Application.ExeName);
  ShowMessage('本程序和擴展名為tes的文件關(guān)聯(lián)');
end;

end.