1:

type PCardinal = ^Cardinal;                    

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;                    

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:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:

unit UClient;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, NarsesBFPA, UProtocol;

type
  TfrmClient = class(TForm)
    OpenDialog: TOpenDialog;
    BtnSend: TButton;
    NBFPAClient: TNBFPAClient;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BtnSendClick(Sender: TObject);
    procedure NBFPAClientRequestData(Sender: TObject; PA: TProtocolAdapter);
    procedure FormCreate(Sender: TObject);
  private
    FOutStream: TFileStream;
  public
    { Public-Deklarationen }
  end;

var
  frmClient: TfrmClient;

implementation

{$R *.dfm}

procedure TfrmClient.FormCreate(Sender: TObject);
begin
  FOutStream := NIL;
end;

procedure TfrmClient.FormShow(Sender: TObject);
begin
  NBFPAClient.SessionName := DateTimeToStr(Now);
  NBFPAClient.Connect;
end;

procedure TfrmClient.BtnSendClick(Sender: TObject);
begin
  if OpenDialog.Execute then begin
    BtnSend.Enabled := FALSE;
    FOutStream := TFileStream.Create(OpenDialog.FileName,
                                     fmOpenRead or fmShareDenyWrite);
    NBFPAClient.Send;
  end;
end;

procedure TfrmClient.NBFPAClientRequestData(Sender: TObject; PA: TProtocolAdapter);
  const
    CHUNK_SIZE = 2048;
  var
    Remaining: Integer;
    Cmd: TCmdSeq;
begin
  if Assigned(FOutStream) then begin
    Remaining := FOutStream.Size -FOutStream.Position;
    if (Remaining > CHUNK_SIZE) then
      Remaining := CHUNK_SIZE;
    Cmd := TCmdSeq.Create(CMD_CHUNK);
    Cmd.Add(FOutStream,Remaining);
    NBFPAClient.SendAndFree(Cmd);
    if (FOutStream.Position = FOutStream.Size) then begin
      FreeAndNil(FOutStream);
      Cmd := TCmdSeq.Create(CMD_STOP);
      NBFPAClient.SendAndFree(Cmd);
      BtnSend.Enabled := TRUE;
    end;
  end;
end;

procedure TfrmClient.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeAndNil(FOutStream);
  NBFPAClient.Disconnect;
end;

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:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:

unit UServer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, NarsesBFPA, UProtocol;

type
  TfrmServer = class(TForm)
    NBFPAServer: TNBFPAServer;
    ListBox: TListBox;
    procedure NBFPAServerConnectionsChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure NBFPAServerClientExecute(Sender: TObject;
      PA: TProtocolAdapter);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  frmServer: TfrmServer;

implementation

{$R *.dfm}

procedure TfrmServer.NBFPAServerConnectionsChange(Sender: TObject);
begin
  ListBox.Items.Assign(NBFPAServer.Connections);
end;

procedure TfrmServer.FormShow(Sender: TObject);
begin
  NBFPAServer.Open;
end;

procedure TfrmServer.NBFPAServerClientExecute(Sender: TObject; PA: TProtocolAdapter);
begin
  case PA.CurrentToken of
    CMD_CHUNK: // Dateistück eingetroffen
      begin
        if (PA.RefObject = NIL) then begin // Datei schon angelegt?
          PA.RefObject := TFileStream.Create(
                            ExtractFilePath(Application.ExeName)+
                              IntToStr(frmServer.Tag)+'.txt',
                            fmCreate);
          PA.OwnsRefObject := TRUE; // beim Freigeben des PAs den FileStream auch
          frmServer.Tag := frmServer.Tag +1; // Dateizähler erhöhen
        end;
        TFileStream(PA.RefObject).Write(PA.Inbound.Data[1]^, // Daten
                                        PA.Inbound.FrameSize[1]); // Menge
      end;
    CMD_STOP: // Dateitransfer beendet
      begin
        TFileStream(PA.RefObject).Free;
        PA.RefObject := NIL; // Referenz entfernen
      end;
  end;
end;

procedure TfrmServer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  NBFPAServer.Close;
end;

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:
47:
48:
49:
50:
51:
52:

type
  TSettings = class(TObject)
  private
    FStr: String;
    FInt: Integer;
  public
    function AsCmdSeq: TCmdSeq;
    property Str: String read FStr write FStr;
    property Int: Integer read FInt write FInt;
  end;

  TForm1 = class(TForm)
    NBFPAClient1: TNBFPAClient;
    NBFPAServer1: TNBFPAServer;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure NBFPAServer1ClientExecute(Sender: TObject; PA: TProtocolAdapter);
  public
    Settings: TSettings;
  end;

implementation

function TSettings.AsCmdSeq: TCmdSeq;
begin
  Result := TCmdSeq.Create(123); // das hier ist die Version 123 der Einstellungen
  Result.Add(FStr); // Eigenschaften schreiben
  Result.Add(FInt);
  //...
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  NBFPAClient1.SendAndFree(Settings.AsCmdSeq);
end;

procedure TForm1.NBFPAServer1ClientExecute(Sender: TObject; PA: TProtocolAdapter);
begin
  case PA.CurrentToken of
    123: // Einstellungen in Version 123 angekommen
      begin
        Settings.Str := PA.Inbound.Strings[1]; // in der gleichen Reihenfolge wieder zuweisen
        Settings.Int := PA.Inbound.AsInt[2]; // wie geschrieben wurde
        //...
      end;
    122: // Einstellungen in Version 122 angekommen (veraltet)
      begin
        Settings.Str := PA.Inbound.Strings[1]; // hier gabs nur den String, der Int war noch nicht bekannt
        //...
      end;
  end;
end;