regftyp.pas

本系统在一些大中型企业(跨多达24个区域)一直都在很好的服务过

unit regftyp;

(*
the procedure registerfiletype associates the given file-extension with the given application
params :
       ft : the file-ext to create an association
       key : the registry-key-name (not necessary)
       desc : a description for the file-type
       icon : the default-icon (not necessary)
       prg  : the application

e.g.
registerfiletype('.txt','textfile','Text-File','','notepad.exe')


(c) 1997 by Markus Stephany
[e-mail]
[e-mail]
Merkes' Pages : http://home.t-online.de/home/mirbir.st/


no guaranties, no restrictions
        *)

interface
uses windows,registry,dialogs;

procedure registerfiletype(ft,key,desc,icon,prg:string);

implementation

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

     // make a correct file-extension
     ct := pos('.',ft);
     while ct > 0 do begin
           delete(ft,ct,1);
           ct := pos('.',ft);
     end;
     if (ft = '') or (prg = '') then exit; //not a valid file-ext or ass. app
     ft := '.'+ft;
     try
        myreg := treginifile.create('');
        myreg.rootkey := hkey_classes_root; // where all file-types are described
        if key = '' then key := copy(ft,2,maxint)+'_auto_file'; // if no key-name is given,
                                                             // create one
        myreg.writestring(ft,'',key); // set a pointer to the description-key
        myreg.writestring(key,'',desc); // write the description
        if icon <> '' then
           myreg.writestring(key+'\DefaultIcon','',icon); // write the def-icon if given
        myreg.writestring(key+'\shell\open\command','',prg+' %1'); //association
     finally
            myreg.free;
     end;
   


end;
end.