unit unitMain; interface uses Registry, shlobj, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TExtForm = class(TForm) ledExtension: TLabeledEdit; ledAssocApp: TLabeledEdit; GetAssocApp: TButton; AssocThisButton: TButton; procedure FormCreate(Sender: TObject); procedure AssocThisButtonClick(Sender: TObject); procedure GetAssocAppClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var ExtForm: TExtForm; implementation {$R *.dfm} 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; procedure TExtForm.FormCreate(Sender: TObject); begin //let's see if the application was called by double clikcing on the associtaed extension if ParamCount > 0 then begin ShowMessage(ParamStr(1)); end; end; procedure TExtForm.AssocThisButtonClick(Sender: TObject); var ext : string; begin //associate without the "." ext := ledExtension.Text; if ext[1] = '.' then ext := Copy(ext,2); RegisterFileType(ext,Application.ExeName) ; ShowMessage('Click the [Get app ".ext"] button now.'); ShowMessage('To test, open up Windows Explorer and double click on a file with "' + ledExtension.Text + '" extension'); end; procedure TExtForm.GetAssocAppClick(Sender: TObject); var sExe:string; begin sEXE := GetExeByExtension(ledExtension.Text) ; ledAssocApp.Text := sEXE; end; end.