regftyp.pas

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

unit regftyp;
(***************************************************************************
This is a unit to handle filetyp-associations in Win95/NT. The unit supports

-Registration of a filetype
-Adding extra-actions to an entry (Like 'Edit' for Batch-Files)
-Adding an entry to the 'New'-Context-Menu
-Removing all the stuff that the unit can create..

Here the description of the procedures:


RegisterFileType :   Registers a filetype
 params:
       ft   : the file-ext to create an association (.txt)
       key  : the registry-key-name (not necessary) (txtfile)
       desc : a description for the file-type       (Text-File)
       icon : the default-icon (not necessary)      (Application.ExeName+',1')
       prg  : the application                       (Application.ExeName

 NOTES:
       The number in the Icon-parameter describes the Index of the Icon in the
       given filename. Note that it begins with 0 for the first icon

 Example:
       registerFileType('.rvc',
                        'rvconfile',
                        'RasInTask Connection',
                        Application.ExeName+',1',
                        Application.ExeName);

-----------------------

DeregisterFileType :    Removes the registration of a filetype
 params:
       ft   : the file-ext to create an association (.txt) (with point!!)

 NOTES:
       -This procedure kills all entries for our filetype. Also features like
        extended actions and entries to the new-context-menu!

 Example:
       deregisterFileType('.tst');

------------------------

FileTAddAction :          Adds an action to the ContextMenu of our filetype
 params:
       key     : the same as in the functions above  (txtfile)
       name    : the name of the action (not necessary) (notepad)
       display : this is shown in the contextMenu (Edit with Notepad)
       action  : The Action to do

 NOTES:
       If you have set up the association with this unit and an empty 'key',
       please give here the file extension.
       Other to the RegisterFileTpe-Call, you MUST set the FULL
       action-parameter:
       If you wish to open the file, you MUST write the %1 at the end,
       because I think that there are many possibilities for an entry in the
       Context-Menu, so I won't destroy many of them..

 Example:
       FileTAddAction('rvconfile','edit','Edit',Application.ExeName+'-e "%1"');

------------------------

FileTDelAction :         Removes the created Action
 params:
       key     : the same as in the functions above  (txtfile)
       name    : the name of the action              (notepad)

 NOTES:
       -If you have set up the association with this unit and an empty 'key',
        please give here the file extension.
       -If you left the param 'name' blank when you created the action, you
        should give here the value of 'display'.
       -Note that you have not to call this procedure if you wish to deregister
        a filetype. My Procedure is very radical and kills the actions too...


 Example:
       FileTDelAction('rvconfile','edit');

procedure FileTAddNew(ft, param: String; newType: TFileNewType);

------------------------

FileTAddNew :         Adds an entry to the New-context-menu
 params:
       ft      : the extension of our file (with point!!) (.txt)
       param   : for extended information (see NOTES)     (Application.ExeName+' -cn')
       newType : the typ of the entry to create           (ftCommand)

 NOTES:
       -The parameter newType is of the type 'TFileNewType' which must have one
        of the following values:
           ftNullFile    If the user clicks on our entry, windows will create
                         a file with the size 0 bytes. The procedure parameter
                         'param' is ignored
           ftFileName    Windows will copy the File you give to this procedure
                         in the 'param'-parameter. Useful, if your application
                         reads a fileheader which must exist...
           ftCommand     Windows launches the program you have given to this
                         procedure in the 'param'-parameter.
                         This can be used to display a wizzard

       -If you use the ftCommand-type, please note that your Wizzard MUST
        display a "Save As"-Dialog ore something like this, if you wish to
        create a file: Windows does not copy or create a file in the folder
        in which the user has clicked on our entry.

 Example:
       FileTAddNew('.tst','', ftNullFile);

------------------------

FileTDelNew :         Removes our entry in the 'New'-ContextMenu
 params:
       ft      : the filetype of our file (with point!!)  (.txt)

 NOTES:
       -Note that you have not to call this procedure if you wish to deregister
        a filetype. My Procedure is very radical and kills the actions too...


 Example:
       FileTDelNew('.tst');

--------------------------------------------------------------------------------

I have written this unit for my Freeware(!) program RasInTask. It is a
dialup-dialer with some extra-feature.

For the version 1.1 I am now implementing a feature named "virtual connections",
and I need to register filetypes. I do not know why Microsoft did not implement
a "RegisterFiletype"-Function to the API. So the programmer has to do very to
much of work.

You can use this Unit when- and whereever you wish. It is freeware.

Please visit my Homepage at http://www.mittelschule.ch/pilif/ for other cool
tools or send an Email to [e-mail] or [e-mail]

Version 1.0

History: none

ToDo-List:

I will add some Errorhandling. Since I did in the past never need to create
exceptions, I do not know how to do this. I will add some as soon as I know
how...

*******************************************************************************)

interface

uses windows,registry,dialogs;

type
     TFileNewType = (ftNullFile, ftFileName, ftCommand); //This is the type of
                                                        //entry to add to the
                                                        //new-menu

procedure registerfiletype(ft,key,desc,icon,prg:string);
procedure deregisterFileType(ft: String);
procedure FileTAddAction(key, name, display, action: String);
procedure FileTDelAction(key, name: String);
procedure FileTAddNew(ft, param: String; newType: TFileNewType);
procedure FileTDelNew(ft: String);

implementation

procedure FileTDelNew(ft: String);
var myReg:TRegistry;
begin
myReg:=TRegistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;
if not myReg.KeyExists(ft) then
 begin
 MyReg.Free;
 Exit;
 end;
MyReg.OpenKey(ft, true);
if MyReg.KeyExists('ShellNew') then
 MyReg.DeleteKey('ShellNew');
MyReg.CloseKey;
MyReg.Free;
end;

procedure FileTAddNew(ft, param: String; newType: TFileNewType);
var myReg:TRegistry;
begin
myReg:=TRegistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;
if not myReg.KeyExists(ft) then
 begin
 MyReg.Free;
 Exit;
 end;
myReg.OpenKey(ft+'\ShellNew', true);
case NewType of
 ftNullFile : MyReg.WriteString('NullFile', '');
 ftFileName : MyReg.WriteString('FileName', param);
 ftCommand  : MyReg.WriteString('Command', param);
end;
MyReg.CloseKey;
MyReg.Free;
end;

procedure FileTDelAction(key, name: String);
var myReg: TRegistry;
begin
myReg:=TRegistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;

if key[1] = '.' then
 key := copy(key,2,maxint)+'_auto_file';

if key[Length(key)-1] <> '\' then //Add a \ if necessary
 key:=key+'\';
myReg.OpenKey('\'+key+'shell\', true);
if myReg.KeyExists(name) then
 myReg.DeleteKey(name);
myReg.CloseKey;
myReg.Free;
end;

procedure FileTAddAction(key, name, display, action: String);
var
myReg:TRegistry;
begin
myReg:=Tregistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;
if name='' then name:=display;

if key[1] = '.' then
 key:= copy(key,2,maxint)+'_auto_file';

if key[Length(key)-1] <> '\' then //Add a \ if necessary
 key:=key+'\';
if name[Length(name)-1] <> '\' then //dito. For only two calls, I won't write a function...
 name:=name+'\';

myReg.OpenKey(key+'Shell\'+name, true);
myReg.WriteString('', display);
MyReg.CloseKey;
MyReg.OpenKey(key+'Shell\'+name+'Command\', true);
MyReg.WriteString('', action);
myReg.Free;
end;


procedure deregisterFileType(ft: String);
var
 myreg:TRegistry;
 key: String;
begin
myreg:=TRegistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;
myReg.OpenKey(ft, False);
key:=MyReg.ReadString('');
MyReg.CloseKey;
//showMEssage(key);
myReg.DeleteKey(ft);
myReg.DeleteKey(key);
myReg.Free;
end;

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;
     myreg := treginifile.create('');
     try
        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;
//     showmessage('File-Type '+ft+' associated with'#13#10+
//     prg+#13#10);



end;
end.