Hello all together,

I want to show you how to register own protocols. (and deleting)

We will write our protocol into the registry.

This procedure opens the registry ein write the following into it.

HKEY_CLASSES_ROOT

    +NAME

         (DEFAULT)           URL:NAME (Describtion)

         EditFlags            2

         Source Filter        [empty]

         URL Protocol         [empty]

         +SHELL

               +OPEN

                    +COMMAND

                            (DEFAULT)         ExecuteStr

The ExecuteStr should include somewhere %1 because at this position the shell-order will be included.

Example:

NAME: Chat;

Describtion: Chatprotocol;

ExecuteStr: "C:\ChatClient.exe %1".

Chat://2002/   -> executes:  "C:\Chatclient.exe Chat://2002/"

procedure RegisterProtocol(const Name, Describtion, ExecuteStr: string);

var

 reg: TRegistry;

begin

 reg := TRegistry.Create;

 try

   reg.RootKey := HKEY_CLASSES_ROOT;

   reg.OpenKey(Name, True);

   try

     reg.Writestring('', 'URL:' + Name +' (' + Describtion + ')');

     reg.WriteInteger('EditFlags', 2);

     reg.WriteString('Source Filter', '');

     reg.WriteString('URL Protocol', '');

     reg.OpenKey('shell', True);

     reg.OpenKey('open', True);

     reg.OpenKey('command', True);

     reg.Writestring('', ExecuteStr);

   finally

     reg.CloseKey;

   end;

 finally

   reg.Free;

 end;

end;

This procedure allows you to delete a protocol again.

Attention: HTTP FTP HTTPS can also be deleted.

procedure UnregisterProtocol(const Name: string);

var

 reg: TRegistry;

begin

 reg := TRegistry.Create;

 try

   reg.RootKey := HKEY_CLASSES_ROOT;

   reg.DeleteKey(Name);

 finally

   reg.Free;

 end;

end;

A little example shall illustrate the using.

We register the "chatprotocol" and read the ParamStr.

After the registering you should go START|EXECUTE and enter "Chat://OnlyAText".

After that you should click button2 to delete the protocol again.

Komponenten / components:

Memo1: TMemo;

Button1: TButton;

Button2: TButton;

procedure TForm1.Button1Click(Sender: TObject);

var

 Name, Describtion, Executestr: string;

begin

 Name        := 'CHAT';

 Describtion := 'BSN CHAT SERVER';

 ExecuteStr  := Application.ExeName + '%1';

 RegisterProtocol(Name, Describtion, ExecuteStr);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

 UnRegisterProtocol('CHAT');

end;

procedure TForm1.FormCreate(Sender: TObject);

var

 i: Integer;

begin

 for i := 0 to PARAMCOUNT do

   Memo1.Lines.Add(ParamStr(i));

end;