TServerSocket in multithread mode

This is a simple multithreaded server build with TServerSocket. The clients (Use Telnet or something) can connect to the server on the predefined port.
After a timeout (when no data is received from the server) the client will be disconnected. All the server does is allow multiple connections on one port. After a new connection is made all data that is sent to the server is echoed back to the client.

View the project source (.DPR)
View the unit source (.PAS)
Download the complete code (.ZIP)

Generated with HyperDelphi

program server;

uses
  Forms,
  main in 'main.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Goto Top

Generated with HyperDelphi

Unit main;

Interface

Uses
  Windows, SysUtils, Messages, Classes, Forms, ScktComp, Controls, StdCtrls,
  Menus, Mask, Spin, ComCtrls, ExtCtrls;

Const
  CM_IncCount = WM_USER + 1;

Type
  TForm1 = Class(TForm)
    ServerSocket: TServerSocket;
    MainMenu: TMainMenu;
    File1: TMenuItem;
    ActiveItem: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Panel1: TPanel;
    Label1: TLabel;
    CacheEdit: TSpinEdit;
    Label2: TLabel;
    PortEdit: TSpinEdit;
    Label3: TLabel;
    ThreadCount: TEdit;
    Panel2: TPanel;
    ListBox1: TListBox;
    Panel3: TPanel;
    StatusBar1: TStatusBar;
    CharCount: TLabel;
    Procedure ServerSocketGetThread(Sender: TObject;
      ClientSocket: TServerClientWinSocket;
      Var SocketThread: TServerClientThread);
    Procedure FormCreate(Sender: TObject);
    Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
    Procedure Exit1Click(Sender: TObject);
    Procedure PortEditChange(Sender: TObject);
    Procedure ActiveItemClick(Sender: TObject);
    Procedure ServerSocketThreadEnd(Sender: TObject;
      Thread: TServerClientThread);
    Procedure ServerSocketThreadStart(Sender: TObject;
      Thread: TServerClientThread);
    Procedure CacheEditChange(Sender: TObject);
  protected
    Procedure CMIncCount(Var Msg: TMessage); message CM_IncCount;
  public
  End;

{ TFileServerThread }

  TFileServerThread = Class(TServerClientThread)
  public
    Procedure ClientExecute; override;
  End;

Var
  Form1: TForm1;

Implementation

{$R *.DFM}

{ TFileServerThread }

Procedure TFileServerThread.ClientExecute;
Var
  Data: Array[0..1023] Of char;
  RecText: String;
  SocketStream: TWinSocketStream;
Begin
  While Not Terminated And ClientSocket.Connected Do
  Try
    SocketStream := TWinSocketStream.Create(ClientSocket, 30000);
    Try
      FillChar(Data, SizeOf(Data), 0);
      If SocketStream.Read(Data, SizeOf(Data)) = 0 Then
      Begin
        // If we didn't get any data after xx seconds then close the connection
        ClientSocket.SendText('Timeout on Server'+#13#10);
        //Wait a little time to allow sending of text before disconnect
        sleep(1);
        ClientSocket.Close;
        Terminate;
      End;
      RecText := Data;
      If Length(RecText) > 2 Then
        Delete(RecText, Pos(#13#10, RecText), 2); // Delete 10
      If ClientSocket.Connected Then
      Begin
        ClientSocket.SendText(RecText);
        SendMessage(Form1.Listbox1.Handle, LB_ADDSTRING, 0, Integer(PChar(RecText)));
        PostMessage(Form1.Handle, CM_INCCOUNT, 0, 0);
      End;
    Finally
      SocketStream.Free;
    End;
  Except
    HandleException;
  End;
End;

Procedure TForm1.ServerSocketGetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket;
  Var SocketThread: TServerClientThread);
Begin
  // Create a new thread for connection
  SocketThread := TFileServerThread.Create(False, ClientSocket);
  ClientSocket.SendText('Welcome to Server'+#13#10);
End;

Procedure TForm1.FormCreate(Sender: TObject);
Begin
  CacheEdit.Value := ServerSocket.ThreadCacheSize;
  PortEdit.Value := ServerSocket.Port;
  CharCount.Caption := '0';
  ActiveItemClick(Nil);
End;

Procedure TForm1.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin
  ServerSocket.Close;
End;

Procedure TForm1.CMIncCount(Var Msg: TMessage);
Begin
  CharCount.Caption := IntToStr(StrToInt(CharCount.Caption) + 1);
End;

Procedure TForm1.Exit1Click(Sender: TObject);
Begin
  Close;
End;

Procedure TForm1.PortEditChange(Sender: TObject);
Begin
  ServerSocket.Port := StrToInt(PortEdit.Text);
End;

Procedure TForm1.ActiveItemClick(Sender: TObject);
Begin
  ServerSocket.Active := Not ServerSocket.Active;
  ActiveItem.Checked := ServerSocket.Active;
  If ServerSocket.Active Then
    StatusBar1.SimpleText := 'Active'
  Else
    StatusBar1.SimpleText := 'InActive';
End;

Procedure TForm1.ServerSocketThreadEnd(Sender: TObject;
  Thread: TServerClientThread);
Begin
  ThreadCount.Text := IntToStr(StrToInt(ThreadCount.Text) - 1);
End;

Procedure TForm1.ServerSocketThreadStart(Sender: TObject;
  Thread: TServerClientThread);
Begin
  ThreadCount.Text := IntToStr(StrToInt(ThreadCount.Text) + 1);
End;

Procedure TForm1.CacheEditChange(Sender: TObject);
Begin
  ServerSocket.ThreadCacheSize := CacheEdit.Value;
End;

End.

Goto Top