Mega Code Archive
How to register an own Protocol (TCP)
<![CDATA[
Title: How to register an own Protocol (TCP)
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.
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;
]]>