Scribd
Upload
14 views4 pages

Delphi Socket Server Implementation

This document contains the code for a server program that uses a TServerSocket component to handle client connections on a separate thread for each client. It displays status information like the number of active threads and received character count. The server echoes any data received from clients back to them and adds the messages to a list box.

Uploaded by

Sutejiey Gang
Copyright
© Attribution Non-Commercial (BY-NC)
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
14 views4 pages

Delphi Socket Server Implementation

This document contains the code for a server program that uses a TServerSocket component to handle client connections on a separate thread for each client. It displays status information like the number of active threads and received character count. The server echoes any data received from clients back to them and adds the messages to a list box.

Uploaded by

Sutejiey Gang
Copyright
© Attribution Non-Commercial (BY-NC)
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd

program server;

uses
Forms,
main in '[Link]' {Form1};

{$R *.RES}

begin
[Link];
[Link](TForm1, Form1);
[Link];
end.

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

Procedure [Link](Sender: TObject;


ClientSocket: TServerClientWinSocket;
Var SocketThread: TServerClientThread);
Begin
// Create a new thread for connection
SocketThread := [Link](False, ClientSocket);
[Link]('Welcome to Server'+#13#10);
End;

Procedure [Link](Sender: TObject);


Begin
[Link] := [Link];
[Link] := [Link];
[Link] := '0';
ActiveItemClick(Nil);
End;

Procedure [Link](Sender: TObject; Var Action: TCloseAction);


Begin
[Link];
End;

Procedure [Link](Var Msg: TMessage);


Begin
[Link] := IntToStr(StrToInt([Link]) + 1);
End;

Procedure TForm1.Exit1Click(Sender: TObject);


Begin
Close;
End;

Procedure [Link](Sender: TObject);


Begin
[Link] := StrToInt([Link]);
End;

Procedure [Link](Sender: TObject);


Begin
[Link] := Not [Link];
[Link] := [Link];
If [Link] Then
[Link] := 'Active'
Else
[Link] := 'InActive';
End;

Procedure [Link](Sender: TObject;


Thread: TServerClientThread);
Begin
[Link] := IntToStr(StrToInt([Link]) - 1);
End;

Procedure [Link](Sender: TObject;


Thread: TServerClientThread);
Begin
[Link] := IntToStr(StrToInt([Link]) + 1);
End;

Procedure [Link](Sender: TObject);


Begin
[Link] := [Link];
End;

End.

You might also like