1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

procedure TMainForm.ClientEncryptData(Sender: TObject; PA: TProtocolAdapter;
  var Buffer; const Size: Integer);
var
  ARCx: TRCxContext;
begin
  RCxInit(ARCx,'<Passwort>');
  RCxEncode(ARCx,Buffer,Buffer,Size);
  RCxDone(ARCx);
end;

procedure TMainForm.ClientDecryptData(Sender: TObject; PA: TProtocolAdapter;
  var Buffer; const Size: Integer);
var
  ARCx: TRCxContext;
begin
  RCxInit(ARCx,'<Passwort>');
  RCxDecode(ARCx,Buffer,Buffer,Size);
  RCxDone(ARCx);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:

type
  TDemoCipher = class(TObject)
  private
    FEncryptionKey: Byte;
    FDecryptionKey: Byte;
    procedure DoEncryption(var Buffer; const Size: Integer; var Key: Byte);
  public
    procedure Reset;
    procedure Encrypt(var Buffer; const Size: Integer);
    procedure Decrypt(var Buffer; const Size: Integer);
  end;

implementation

procedure TDemoCipher.Reset;
begin
  FEncryptionKey := 0;
  FDecryptionKey := 0;
end;

procedure TDemoCipher.DoEncryption(var Buffer; const Size: Integer; var Key: Byte);
  var
    i: Integer;
begin
  for i := 0 to Size-1 do begin
    TByteArray(Buffer)[i] := TByteArray(Buffer)[i] xor Key;
    Inc(Key);
  end;
end;

procedure TDemoCipher.Encrypt(var Buffer; const Size: Integer);
begin
  DoEncryption(Buffer,Size,FEncryptionKey);
end;

procedure TDemoCipher.Decrypt(var Buffer; const Size: Integer);
begin
  DoEncryption(Buffer,Size,FDecryptionKey);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:

// neue Verbindung hergestellt
procedure TServerMain.NBFPAServer1CreatePA(Sender: TObject; PA: TProtocolAdapter);
begin
  PA.RefObject := TDemoCipher.Create; // Verschlüsselungskontext anlegen
  PA.OwnsRefObject := TRUE; // beim Freigeben den Kontext mit entsorgen
end;

// Sendedaten im Kontext der Verbindung verschlüsseln
procedure TServerMain.NBFPAServer1EncryptData(Sender: TObject;
  PA: TProtocolAdapter; var Buffer; const Size: Integer);
begin
  TDemoCipher(PA.RefObject).Encrypt(Buffer,Size);
end;

// Empfangsdaten im Kontext der Verbindung entschlüsseln
procedure TServerMain.NBFPAServer1DecryptData(Sender: TObject;
  PA: TProtocolAdapter; var Buffer; const Size: Integer);
begin
  TDemoCipher(PA.RefObject).Decrypt(Buffer,Size);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:

// Bei Programmstart ausführen
procedure TClientMain.FormCreate(Sender: TObject);
begin
  FDemoCipher := TDemoCipher.Create; // statischen Verschlüsselungskontext anlegen
  NBFPAClient1ConnectionStateChange(Self); // GUI aktualisieren
end;

// Verbindung zu einem Server (erneut) hergestellt
procedure TClientMain.NBFPAClient1Reset(Sender: TObject; PA: TProtocolAdapter);
begin
  FDemoCipher.Reset; // Kontext (re-)initialisieren
end;

// Sendedaten im statischen Kontext verschlüsseln
procedure TClientMain.NBFPAClient1EncryptData(Sender: TObject;
  PA: TProtocolAdapter; var Buffer; const Size: Integer);
begin
  FDemoCipher.Encrypt(Buffer,Size);
end;

// Empfangsdaten im statischen Kontext entschlüsseln
procedure TClientMain.NBFPAClient1DecryptData(Sender: TObject;
  PA: TProtocolAdapter; var Buffer; const Size: Integer);
begin
  FDemoCipher.Decrypt(Buffer,Size);
end;

// Bei Programmende ausführen
procedure TClientMain.FormDestroy(Sender: TObject);
begin
  FDemoCipher.Free; // Kontext-Objekt freigeben
  // Wenn der Kontext aus Sicherheitsgründen schon vorher entsorgt werden soll,
  // einfach im OnDisconnect leeren bzw. reinitialisieren.
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:

uses
  ..., RC4;

type
  TRC4Adapter = class(TObject)
  private
    FEncryptionContext: TRC4Context;
    FDecryptionContext: TRC4Context;
  public
    constructor Create(const AKey: String);
    destructor Destroy; override;
    procedure Reset(const AKey: String);
    procedure Encrypt(var Buffer; const Size: Integer);
    procedure Decrypt(var Buffer; const Size: Integer);
  end;

implementation

constructor TRC4Adapter.Create(const AKey: String);
begin
  inherited Create;
  Reset(AKey);
end;

destructor TRC4Adapter.Destroy;
begin
  RC4Done(FEncryptionContext);
  RC4Done(FDecryptionContext);
  inherited;
end;

procedure TRC4Adapter.Reset(const AKey: String);
begin
  RC4Init(FEncryptionContext,AKey);
  RC4Init(FDecryptionContext,AKey);
end;

procedure TRC4Adapter.Encrypt(var Buffer; const Size: Integer);
begin
  RC4Code(FEncryptionContext,Buffer,Buffer,Size);
end;

procedure TRC4Adapter.Decrypt(var Buffer; const Size: Integer);
begin
  RC4Code(FDecryptionContext,Buffer,Buffer,Size);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:

// neue Verbindung hergestellt
procedure TServerMain.NBFPAServer1CreatePA(Sender: TObject; PA: TProtocolAdapter);
begin
  PA.RefObject := TRC4Adapter.Create('*geheim*'); // Verschlüsselungskontext anlegen
  PA.OwnsRefObject := TRUE; // beim Freigeben den Kontext mit entsorgen
end;

// Sendedaten im Kontext der Verbindung verschlüsseln
procedure TServerMain.NBFPAServer1EncryptData(Sender: TObject;
  PA: TProtocolAdapter; var Buffer; const Size: Integer);
begin
  TRC4Adapter(PA.RefObject).Encrypt(Buffer,Size);
end;

// Empfangsdaten im Kontext der Verbindung entschlüsseln
procedure TServerMain.NBFPAServer1DecryptData(Sender: TObject;
  PA: TProtocolAdapter; var Buffer; const Size: Integer);
begin
  TRC4Adapter(PA.RefObject).Decrypt(Buffer,Size);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:

// Bei Programmstart ausführen
procedure TClientMain.FormCreate(Sender: TObject);
begin
  FRC4Adapter := TRC4Adapter.Create(''); // nur Objekt anlegen
  NBFPAClient1ConnectionStateChange(Self); // GUI aktualisieren
end;

// Verbindung zu einem Server (erneut) hergestellt
procedure TClientMain.NBFPAClient1Reset(Sender: TObject; PA: TProtocolAdapter);
begin
  FRC4Adapter.Reset('*geheim*'); // Kontext (re-)initialisieren
end;

// Sendedaten im statischen Kontext verschlüsseln
procedure TClientMain.NBFPAClient1EncryptData(Sender: TObject;
  PA: TProtocolAdapter; var Buffer; const Size: Integer);
begin
  FRC4Adapter.Encrypt(Buffer,Size);
end;

// Empfangsdaten im statischen Kontext entschlüsseln
procedure TClientMain.NBFPAClient1DecryptData(Sender: TObject;
  PA: TProtocolAdapter; var Buffer; const Size: Integer);
begin
  FRC4Adapter.Decrypt(Buffer,Size);
end;

// Bei Programmende ausführen
procedure TClientMain.FormDestroy(Sender: TObject);
begin
  FRC4Adapter.Free; // Kontext-Objekt freigeben
  // Wenn der Kontext aus Sicherheitsgründen schon vorher entsorgt werden soll,
  // einfach im OnDisconnect leeren bzw. reinitialisieren.
end;