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:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:

unit Unit1;

interface

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

const
  // Port, an dem der ServerSocket auf Clients wartet
  SERVER_PORT = 12345;

type
  // ein Kommando besteht aus einem Text und einer Anzahl Argumente
  TCmdSyntax = record
    Text: ShortString; // Kommando-Text
    ArgCount: Integer; // Anzahl der Argumente incl. dem Kommando-Text
  end;

  // bekannte Kommandos aufzählen
  TCmdToken = (
    cmdNOP = 0, // nichts tun (bis D5 das "= 0" weglassen!)
    cmdSAID,    // Textnachricht ausgeben
    cmdUSER,    // neue User-Liste
    cmdERROR    // Fehler, ungültiger Befehl
    );

  // Verbindungszustände des Clients (für die Button-Steuerung)
  TMyConState = (
    mcsOffline, // nicht verbunden
    mcsPending, // Verbindungsstatus ändert sich gerade
    mcsOnline   // verbunden
    );

  TForm1 = class(TForm)
    Server: TEdit;
    BtnConnect: TButton;
    BtnDisconnect: TButton;
    Nickname: TEdit;
    Log: TMemo;
    Input: TEdit;
    BtnSend: TButton;
    Clients: TListBox;
    ClientSocket1: TClientSocket;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BtnConnectClick(Sender: TObject);
    procedure BtnDisconnectClick(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure BtnSendClick(Sender: TObject);
    procedure InputKeyPress(Sender: TObject; var Key: Char);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure ParseBuffer;
    function GetCmdToken(const StrToken: String): TCmdToken;
    procedure Execute(const Command: TCmdToken; Data: TStringList);
  private
    FMyConState: TMyConState;
    procedure SetConState(const Value: TMyConState);
  public
    ReceiveBuffer: String; // Empfangspuffer
    property ConnectionState: TMyConState read FMyConState write SetConState;
  end;

const
  // Protokoll-Syntax-Definition
  Syntax: Array[TCmdToken] of TCmdSyntax = (
    (Text: '';     ArgCount: 1), // NOP
    (Text: 'SAID'; ArgCount: 3), // SAID
    (Text: 'USER'; ArgCount: 2), // USER
    (Text: '';     ArgCount: 1)  // ERROR; ist nur ein Dummy-Befehl -> kein Text
    );

var
  Form1: TForm1;

implementation

{$R *.dfm}

// bei Programmstart ausführen
procedure TForm1.FormCreate(Sender: TObject);
begin
  ClientSocket1.Port := SERVER_PORT; // Port setzen
  ConnectionState := mcsOffline; // Buttons anpassen
end;

// neuer Verbindungsstatus -> GUI anpassen
procedure TForm1.SetConState(const Value: TMyConState);
begin
  FMyConState := Value; // neuen Status speichern
  // Buttons entsprechend de-/aktivieren
  BtnConnect.Enabled := (Value = mcsOffline);
  BtnDisconnect.Enabled := (Value = mcsOnline);
  BtnSend.Enabled := (Value = mcsOnline);
end;

// bei Programmende ausführen
procedure TForm1.FormDestroy(Sender: TObject);
begin
  BtnDisconnectClick(Self); // auf jeden Fall abmelden
end;

// Verbindung zum Server aufnehmen
procedure TForm1.BtnConnectClick(Sender: TObject);
begin
  ConnectionState := mcsPending; // Buttons anpassen
  ClientSocket1.Host := Server.Text; // Serveradresse übernehmen
  ClientSocket1.Open; // Verbindung versuchen und warten, was passiert
  // Verbindung OK: weiter bei ClientSocket1Connect(), sonst ClientSocket1Error()
end;

// Verbindung zum Server trennen
procedure TForm1.BtnDisconnectClick(Sender: TObject);
begin
  ConnectionState := mcsPending; // Buttons anpassen
  if (ClientSocket1.Active) then // noch verbunden?         // Hier zeigt mir Delphi irgendetwas mit einem Grünen Pfiel  an
    ClientSocket1.Close // dann trennen und warten, was passiert
  // Trennung OK: weiter in ClientSocket1Disconnect(), sonst ClientSocket1Error()
  else
    ConnectionState := mcsOffline; // sonst sind wir schon Offline
end;

// Verbindung zum Server ist aufgebaut und bereit zum Senden/Empfangen
procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  ReceiveBuffer := ''; // Empfangspuffer initialisieren
  ConnectionState := mcsOnline; // Buttons anpassen
  Log.Clear; // Protokollfenster löschen
  Log.Lines.Add('Verbunden mit: '+ClientSocket1.Socket.RemoteHost);
  Socket.SendText('NICK'+#13+Nickname.Text+#13); // noch den eigenen Nickname senden
end;

// Verbindung zum Server (normal) getrennt
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  ConnectionState := mcsOffline; // Buttons anpassen
  Clients.Clear; // User-Liste leeren
  Log.Lines.Add('Verbindung getrennt.');
end;

// Es ist ein Fehler in der Verbindung aufgetreten; sicherheitshalber trennen
procedure TForm1.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  if (ClientSocket1.Active) then // noch verbunden?
    ClientSocket1.Close; // ja, dann trennen
  ConnectionState := mcsOffline; // Buttons anpassen
  Clients.Clear; // User-Liste leeren
  ErrorCode := 0; // Fehler behandelt, keine Exception erzeugen
  Log.Lines.Add('Verbindungsfehler!');
end;

// Benutzernachricht senden ("reden")
procedure TForm1.BtnSendClick(Sender: TObject);
begin
  ClientSocket1.Socket.SendText('SAY'+#13+Input.Text+#13);
end;

// Eingabetaste im Textfeld -> senden und wieder alles auswählen
procedure TForm1.InputKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = #13) then begin // Return/Enter gedrückt?
    BtnSendClick(Self); // dann Text senden
    Input.SetFocus; // Editfeld wieder auswählen
    Input.SelectAll; // und den ganzen Text markieren
  end;
end;

// Daten vom Server empfangen
procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
begin
  ReceiveBuffer := ReceiveBuffer +Socket.ReceiveText; // Daten lesen
  if (ReceiveBuffer <> '') then // wenn Daten da sind...
    ParseBuffer; // ...versuchen, Befehle auszuführen
end;

// Empfangspuffer nach Befehlen durchsuchen und dann ausführen
procedure TForm1.ParseBuffer;
  var
    Data: TStringList; // zum Zerlegen des Empfangspuffers
    Current: TCmdToken; // aktuelles Kommando
    OutOfArg: Boolean; // Flag zum Abbrechen der Befehlssuche
begin
  Data := TStringList.Create;
  try
    Data.Text := ReceiveBuffer; // Empfangspufferdaten in Pakete zerlegen
    OutOfArg := FALSE; // wir nehmen mal an, es sind genug Argumente da
    while ( (Data.Count > 0) // solange noch Befehle da sind und
            and (NOT OutOfArg) ) do begin // die Argumente dafür reichen
      // Befehl erkennen (gross/klein egal)
      Current := GetCmdToken(UpperCase(Data.Strings[0]));
      // ausreichend Argumente dafür da?
      if (Data.Count >= Syntax[Current].ArgCount) then
        Execute(Current,Data) // ja, dann bearbeiten
      else // nein -> auf neue Daten warten...
        OutOfArg := TRUE;
    end;
    // noch nicht verarbeitete Werte wieder in den Puffer zurück
    ReceiveBuffer := Data.Text;
  finally
    Data.Free;
  end;
end;

// Befehlstoken zu übergebenem String suchen
function TForm1.GetCmdToken(const StrToken: String): TCmdToken;
begin
  Result := Low(Syntax); // erster Befehl
  while ( (Result < cmdERROR) // solange noch nicht alle Befehle durch sind
          and                 // und
          (StrToken <> Syntax[Result].Text) ) do // der Befehl nicht passt
    Inc(Result); // nächsten Befehl nehmen
  // Die Schleife bricht spätestens bei cmdERROR ab
end;

// Befehle ausführen; die notwendige Anzahl Argumente ist garantiert
procedure TForm1.Execute(const Command: TCmdToken; Data: TStringList);
  var
    i: Integer;
begin
  case Command of // Befehle fallunterscheiden:
    cmdNOP: // naja, eben nichts tun...
      ;
    cmdSAID: // Text mit Autorenangabe anzeigen
      Log.Lines.Add(Data.Strings[1]+': '+Data.Strings[2]);

    cmdUSER: // User-Liste aktualisieren
      Clients.Items.CommaText := Data.Strings[1];

    else // ungültiges Kommando loggen und dann wegwerfen
      Log.Lines.Add('Unbekanntes Kommando: '+Data.Strings[0]);
  end;
  // verarbeitete Werte löschen
  for i := 1 to Syntax[Command].ArgCount do // soviele Werte, wie dieser Befehl hat
    Data.Delete(0); // aus der Befehlskette (vorne!) löschen
end;

end.