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:

unit Unit1;

interface

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

const
  CMD_ListBox = 1;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ListBox2: TListBox;
    Button1: TButton;
    NBFPAClient1: TNBFPAClient;
    NBFPAServer1: TNBFPAServer;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure NBFPAServer1ClientExecute(Sender: TObject;
      PA: TProtocolAdapter);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  NBFPAServer1.Open;
  Application.ProcessMessages;
  NBFPAClient1.Connect;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var
    Cmd: TCmdSeq;
begin
  Cmd := TCmdSeq.Create(CMD_ListBox);
  Cmd.Add(ListBox1.Items);
  NBFPAClient1.SendAndFree(Cmd);
end;

procedure TForm1.NBFPAServer1ClientExecute(Sender: TObject; PA: TProtocolAdapter);
  var
    i: Integer;
begin
  case PA.CurrentToken of
    CMD_ListBox:
      begin
        ListBox2.Clear;
        for i := 1 to PA.CurrentArgCount-1 do
          ListBox2.Items.Add(PA.Inbound.Strings[i]);
      end;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  NBFPAClient1.Disconnect;
  Application.ProcessMessages;
  NBFPAServer1.Close;
end;

end.                    

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

procedure GetProcessList(const aProcessList: TStrings);
var
  Snap: THandle;
  ProcessE: TProcessEntry32;
begin
  aProcessList.Clear;
  Snap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    ProcessE.dwSize := SizeOf(ProcessE);
    if Process32First(Snap, ProcessE) then
      Repeat
        aProcessList.Add(ProcessE.szExeFile);
      Until not Process32Next(Snap, ProcessE)
    else
      RaiseLastOSError;
  finally
    CloseHandle(Snap);
  end;
end;                    

1:

GetProcessList(ProzessListe);                    

1:

var ProzessListe: TStrings;                    

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

procedure TForm1.Button1Click(Sender: TObject);  
  var  
    SL: TStringList;
    Cmd: TCmdSeq;  
begin  
  SL := TStringList.Create;
  try
    SL.Add('Test1');
    SL.Add('Test2');
    Cmd := TCmdSeq.Create(CMD_ListBox);  
    Cmd.Add(SL);  
    NBFPAClient1.SendAndFree(Cmd);
  finally
    SL.Free;
  end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:

GetProcessList(ProzessListe);
try
Cmd := TCmdSeq.Create(CMD_ListBox);
Cmd.Add(ProzessListe);
NBFPAClient1.SendAndFree(Cmd);
finally
ProzessListe.Free;
end;
end;                    

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

procedure GetProcessList(const aProcessList: TStringList);
var
  Snap: THandle;
  ProcessE: TProcessEntry32;
begin
  aProcessList.Clear;
  Snap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    ProcessE.dwSize := SizeOf(ProcessE);
    if Process32First(Snap, ProcessE) then
      Repeat
        aProcessList.Add(ProcessE.szExeFile);
      Until not Process32Next(Snap, ProcessE)
    else
      RaiseLastOSError;
  finally
    CloseHandle(Snap);
  end;
end;                    

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

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var antwort : STRING;
var Cmd: TCmdSeq;
begin
antwort := Socket.ReceiveText;

[...]

if antwort = 'PROZLIST' then begin
  GetProcessList(ProzessListe);
  try
    Cmd := TCmdSeq.Create(CMD_ListBox);
    Cmd.Add(ProzessListe);
    NBFPAClient1.SendAndFree(Cmd);
  finally;
  end;
end;                    

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

// Neuer Client: bisherige Benutzerliste an den Neuen senden
procedure TServerMain.NBFPAServer1ClientConnect(Sender: TObject;
  PA: TProtocolAdapter);
  var
    Cmd: TCmdSeq;
    i: Integer;
begin
  // alle Verbindungen des Servers durchgehen...
  for i := 0 to NBFPAServer1.Connections.Count-1 do
    // ist die betrachtete Verbindung (i) die Neue?
    if (NBFPAServer1.ConnectionByIndex[i] <> PA) then begin // nein, dann...
      Cmd := TCmdSeq.Create(CMD_USERDATA); // Details der Verbindung einsammeln
      Cmd.Add(NBFPAServer1.ConnectionByIndex[i].SessionID);
      Cmd.Add(NBFPAServer1.ConnectionByIndex[i].SessionName);
      PA.Outbound.AddCmdAndFree(Cmd); // und dem neuen Client mitteilen
    end;
  // .Send ist nicht notwendig, weil kurz nach dem OnConnect eh ein OnSession-
  // NameChange-Ereignis eintritt, in dem auch an den neuen Client gesendet wird.
end;                    

1:
2:
3:
4:
5:
6:

  var
    Cmd: TCmdSeq;
begin
  Cmd := TCmdSeq.Create(... blah;
  NBFPAServer1.ConnectionsByIndex[i].Outbound.AddCmdAndFree(Cmd);
  NBFPAServer1.ConnectionsByIndex[i].Send;