unit Vchat;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, WSocketS, WSocket, TFlatButtonUnit, TFlatEditUnit,
  TFlatMemoUnit, TFlatHintUnit;

const
  WM_APPSTARTUP = WM_USER + 1;

type
  TChatClient = class(TWSocketClient)
     public
        RcvdLine: string;
     end;

  TfrmChat = class(TForm)
    pnlChat: TPanel;
    Schat: TWSocketServer;
    cmdSend: TFlatButton;
    memChat: TFlatMemo;
    Msg: TFlatEdit;
    procedure cmdSendClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SchatClientConnect(Sender: TObject; Client: TWSocketClient;
      Error: Word);
    procedure FormHide(Sender: TObject);
  private
    { Private declarations }
    procedure WMAppStartup(var Msg: TMessage); message WM_APPSTARTUP;
    procedure ProcessData(Client: TChatClient);
    procedure ClientDataAvailable(Sender: TObject; Error: Word);
  public
    { Public declarations }
  end;

var
  frmChat: TfrmChat;

implementation

uses System32;

{$R *.DFM}

procedure TfrmChat.WMAppStartup(var Msg: TMessage);
begin
   Schat.Proto := 'tcp';
   Schat.Port := '6668';
   Schat.Addr := '0.0.0.0';
   Schat.ClientClass := TChatClient;
   Schat.Listen;
end;

procedure TfrmChat.SchatClientConnect(Sender: TObject;
  Client: TWSocketClient; Error: Word);
begin
   with Client as TChatClient do
      begin
         LineMode        := TRUE;
         LineEdit        := TRUE;
         OnDataAvailable := ClientDataAvailable;
      end;
end;

procedure TfrmChat.ClientDataAvailable(Sender : TObject;
  Error  : Word);
begin
   with Sender as TChatClient do
      begin
         RcvdLine := ReceiveStr;
      while (Length(RcvdLine) > 0) and
      (RcvdLine[Length(RcvdLine)] in [#13, #10]) do
      RcvdLine := Copy(RcvdLine, 1, Length(RcvdLine) - 1);
      ProcessData(Sender as TChatClient);
    end;
end;

procedure TfrmChat.ProcessData(Client: TChatClient);
begin
   memChat.Lines.Add(Client.RcvdLine);
end;

procedure TfrmChat.cmdSendClick(Sender: TObject);
var
  You, Say: string;
  Client: TChatClient;
begin
   You := 'server: ';
   Say := Msg.Text;
   Client.SendStr(You + Say + #13#10);
   memChat.Lines.Add(You + ': ' + Say);
   Msg.Clear;
end;

procedure TfrmChat.FormShow(Sender: TObject);
begin
   PostMessage(Handle, WM_APPSTARTUP, 0, 0);
end;

procedure TfrmChat.FormHide(Sender: TObject);
var
  Client: TChatClient;
begin
   Client.CloseDelayed;
   memChat.Clear;
   Msg.Clear;
end;

end.
