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:

type
  TClient = class
  private
   CliSocket : TClientSocket;
   procedure CliSocketRead(ASender: TObject; Socket: TCustomWinSocket);
   procedure CliSocketError(ASender: TObject; Socket: TCustomWinSocket;
   ErrorEvent: TErrorEvent; var ErrorCode: Integer);
   procedure CliSocketConnect(ASender: TObject; Socket: TCustomWinSocket);
   procedure CliSocketDisconnect(ASender: TObject; Socket: TCustomWinSocket);
  Public
   Constructor CreateNewSession(IP, UserID :string); reintroduce;
end;

Type
  TForm2 = class(TForm)
    GroupBox1: TGroupBox;
    PageControl1: TPageControl;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ImageList1: TImageList;
    ToolBar2: TToolBar;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    Memo1: TMemo;
    ImageList2: TImageList;
    LMDSimplePanel1: TLMDSimplePanel;
    Image1: TImage;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    StaticText1: TStaticText;
    LMDSimplePanel2: TLMDSimplePanel;
    LMDSpeedButton1: TLMDSpeedButton;
    Log: TMemo;
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    Procedure CreateNewTab(UserID:String);

    procedure ParseBuffer;
    function GetCmdToken(const StrToken: String): TCmdToken;
    procedure ExecuteX(const Command: TCmdToken; Data: TStringList);
  end;



var
  Form2: TForm2;

  ReceiveBuffer: String; // Empfangspuffer
  Tab: TTabSheet;
  WB: TWebbrowser;

  ASender: TObject;
  Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent;
  ErrorCode: Integer;

implementation
uses Unit1;
{$R *.dfm}

// Empfangspuffer nach Befehlen durchsuchen und dann ausführen
procedure TForm2.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
        ExecuteX(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 TForm2.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 TForm2.ExecuteX(const Command: TCmdToken; Data: TStringList);
  var
    i: Integer;
begin
  case Command of
    cmdNOP: ;
    cmdSAID: Log.Lines.Add(Data.Strings[1]+': '+Data.Strings[2]);
    cmdUSER: form1.Clients.Items.CommaText := Data.Strings[1];
    cmdIP:   form1.Clients.Items.CommaText := Data.Strings[1];
    else
      form1.WriteEvLog('Unbekanntes Kommando: '+Data.Strings[0]);
  end;
  for i := 1 to Syntax[Command].ArgCount do
    Data.Delete(0);
end;

Procedure TForm2.CreateNewTab(UserID:String);
begin
 Tab := TTabsheet.Create(self);
 Tab.PageControl := PageControl1;
 Tab.Caption := UserID;
 Tab.Name := 'TabX' + IntToStr(PageControl1.PageCount);
 PageControl1.ActivePage := Tab;
 WB := TWebbrowser.Create(self);
 TControl(WB).Parent := Tab;
 TControl(WB).Name := 'Webbrowser' + IntToStr(PageControl1.PageCount);
 WB.Visible := true;
 WB.Align := alClient;
end;

Constructor TClient.CreateNewSession(IP, UserID :string);
begin
 CliSocket := TClientSocket.Create(nil);
 try
  CliSocket.OnConnect(ASender, Socket);
  CliSocket.OnDisconnect(ASender, Socket);
  CliSocket.OnError(ASender, Socket,ErrorEvent,ErrorCode);
  CliSocket.OnRead(ASender, Socket);

 with CliSocket do
 begin
  Name := 'Cli_'+UserID;
  Port := Server_port;
  Host := IP;
  Active := true;
 end;
 except
  exit;
 end;
end;

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

// Es ist ein Fehler in der Verbindung aufgetreten; sicherheitshalber trennen
procedure TClient.CliSocketError(ASender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  ErrorCode := 0; // Fehler behandelt, keine Exception erzeugen
  form2.Log.Lines.Add('Verbindungsfehler!');
end;

// Verbindung zum Server ist aufgebaut und bereit zum Senden/Empfangen
procedure TClient.CliSocketConnect(ASender: TObject; Socket: TCustomWinSocket);
begin
  ReceiveBuffer := ''; // Empfangspuffer initialisieren
  form2.Log.Clear; // Protokollfenster löschen
  form2.Log.Lines.Add('Verbunden mit: '+CliSocket.Host);
  // noch den eigenen Nickname senden
  Socket.SendText(Syntax[cmdNICK].Text+#13+form1.LabeledEdit1.Text+#13);
end;

// Verbindung zum Server (normal) getrennt
procedure TClient.CliSocketDisconnect(ASender: TObject;
  Socket: TCustomWinSocket);
begin
  form1.Clients.Clear; // User-Liste leeren
  form2.Log.Lines.Add('Verbindung getrennt.');
end;
end.                    

1:
2:
3:
4:

  CliSocket.OnConnect(ASender, Socket);
  CliSocket.OnDisconnect(ASender, Socket);
  CliSocket.OnError(ASender, Socket,ErrorEvent,ErrorCode);
  CliSocket.OnRead(ASender, Socket);