Mega Code Archive
Register an own protocol [tcp]
<![CDATA[
{
+++ German: ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Hallo alle zusammen,
ich möchte euch zeigen, wie man eigene Protokolle registriert. (bzw. löscht)
Wir schreiben dazu unser Protokoll in die Registry.
+++ English: +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Hello all together,
I want to show you how to register own protocols. (and deleting)
We will write our protocol into the registry.
}
{
+++ German: ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Diese Procedur öffnet die Registry und schreibt folgendes rein:
HKEY_CLASSES_ROOT
+NAME
(STANDARD) URL:NAME (ERKLÄRUNG)
EditFlags 2
Source Filter [leer]
URL Protocol [leer]
+SHELL
+OPEN
+COMMAND
(STANDARD) ExecuteStr
Der ExecuteStr sollte irgendwo %1 enthalten, da an dieser Stelle der Shellbefehl angegeben wird.
BSP:
NAME: Chat;
Describtion: Chatprotokoll;
ExecuteStr: "C:\ChatClient.exe %1".
Chat://2002/ -> Führt "C:\Chatclient.exe Chat://2002/" aus.
+++ English: +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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;
{
+++ German: ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Diese Prozedur ermöglich das Löschen eines Protokolls.
Vorsicht: AUCH HTTP FTP HTTPS können gelöscht werden!!!
+++ English: +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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;
{
+++ German: ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Ein kleines Beispiel soll die Verwendung zeigen.
Wir registrieren das Chatprotokoll und lesen die ParamStr aus.
Nach dem registrieren gehen sie Start|Ausführen und geben sie "CHAT://OnlyaTest" ein.
Danach klicken sie Button2 um das Protokoll wieder zu löschen.
+++ English: +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
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;
]]>