...ein eigenes Protokoll registrieren (TCP)?

{
+++ 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;

printed from
www.swissdelphicenter.ch
developers knowledge base