INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Networking

How do I bind multiple ports on an Indy server as if it were one client connection? by djjd47130
Posted: 11 Jun 12

This explanation is using the TIdTCPServer from Indy 10 in Delphi XE2. The same should apply for prior versions but the code may differ. I will be demonstrating this with a class wrapping the server and client connections. This presumes that you already have a general understanding of server/client socket communication with Indy 10.

An Indy Server has the ability to bind more than one IP/Port at the same time. This allows you to use your server as multiple servers at once. These bindings are available in the property TIdTCPServer.Bindings. These bindings should be assigned at the time that you are activating your server. You need to make sure you first clear any previous bindings first.

The client side still needs to have a separate component for each socket. Multiple bindings are not available on clients. So in my wrapper below, the client has two instances of TIdTCPClient.

The example below consists of two units: MySockets.pas and uMySocketTest.pas. Create a new VCL Forms Application, name the main form frmMain and save it as uMySocketTest.pas. Drop a single TButton control on this form, and create an event handler for its OnClick event. Then, create an event handler for the form's OnCreate and OnDestroy events. Now, replace all the unit's code with this code below:

uMySocketTest.pas

CODE

unit uMySocketTest;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, MySockets, Vcl.StdCtrls;

type
TfrmMain = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
FServer: TMyServer;
FClient: TMyClient;
public

end;

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.Button1Click(Sender: TObject);
var
DT: TDateTime;
begin
FServer.PortA:= 2999;
FServer.PortB:= 2777;
FServer.Active:= True;
FClient.Port:= 2999;
FClient.Host:= '192.168.4.100';
FClient.Active:= True;
DT:= FClient.GetDateTime;
ShowMessage(FormatDateTime('mm/dd/yy hh:nn am/pm', DT));
FClient.Active:= False;
FServer.Active:= False;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
FServer:= TMyServer.Create(nil);
FClient:= TMyClient.Create(nil);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
FClient.Disconnect;
FServer.Active:= False;
FClient.Free;
FServer.Free;
end;

end.

Now that this form is here, you need to create a new unit named MySockets.pas and replace the code with this:

MySockets.pas

CODE

unit MySockets;

interface

uses
Winapi.Windows, Winapi.Winsock, System.Classes, System.SysUtils,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPConnection,
IdTCPServer, IdTCPClient, IdYarn, IdContext, IdSocketHandle;

type
TMyServer = class;
TMyClient = class;
TMyServerContext = class;
TMyServerClient = class;
TMyServerClients = class;

TMyServerContext = class(TIdServerContext)
private
FID: Integer;
public
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
AList: TThreadList = nil); reintroduce;
destructor Destroy; override;
property ID: Integer read FID;
end;

TMyServerClient = class(TObject)
private
FOwner: TMyServerClients;
FContextB: TMyServerContext;
FContextA: TMyServerContext;
FID: Integer;
procedure SetContextA(const Value: TMyServerContext);
procedure SetContextB(const Value: TMyServerContext);
public
constructor Create(AOwner: TMyServerClients);
destructor Destroy; override;
property ContextA: TMyServerContext read FContextA write SetContextA;
property ContextB: TMyServerContext read FContextB write SetContextB;
property ID: Integer read FID;
end;

TMyServerClients = class(TObject)
private
FOwner: TMyServer;
FItems: TThreadList;
function GetItem(Index: Integer): TMyServerClient;
function GetClient(ID: Integer): TMyServerClient;
public
constructor Create(AOwner: TMyServer);
destructor Destroy; override;
function Add: TMyServerClient; overload;
function Add(ContextA: TMyServerContext): TMyServerClient; overload;
procedure Delete(const Index: Integer);
procedure DeleteID(const ID: Integer);
function IndexOfID(const ID: Integer): Integer;
function Count: Integer;
procedure Clear;
property Items[Index: Integer]: TMyServerClient read GetItem; default;
property Client[ID: Integer]: TMyServerClient read GetClient;
end;

TMyServer = class(TComponent)
private
FServer: TIdTCPServer;
FActive: Bool;
FPortB: Integer;
FPortA: Integer;
FClients: TMyServerClients;
FLastID: Integer;
procedure SvrConnect(AContext: TIdContext);
procedure SvrDisconnect(AContext: TIdContext);
procedure SvrContextCreated(AContext: TIdContext);
procedure SvrExecute(AContext: TIdContext);
procedure SetActive(const Value: Bool);
procedure SetPortA(const Value: Integer);
procedure SetPortB(const Value: Integer);
function GetLocalAddress: String;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property LocalAddress: String read GetLocalAddress;
function NewID: Integer;
published
property Active: Bool read FActive write SetActive;
property PortA: Integer read FPortA write SetPortA;
property PortB: Integer read FPortB write SetPortB;
end;

TMyClient = class(TComponent)
private
FClientA: TIdTCPClient;
FClientB: TIdTCPClient;
FPort: Integer;
FHost: String;
FActive: Bool;
FPortB: Integer;
FID: Integer;
procedure AConnected(Sender: TObject);
procedure ADisconnected(Sender: TObject);
procedure BConnected(Sender: TObject);
procedure BDisconnected(Sender: TObject);
procedure SetHost(const Value: String);
procedure SetPort(const Value: Integer);
procedure SetActive(const Value: Bool);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetDateTime: TDateTime;
procedure Connect;
procedure Disconnect;
property PortB: Integer read FPortB;
property ID: Integer read FID;
published
property Active: Bool read FActive write SetActive;
property Host: String read FHost write SetHost;
property Port: Integer read FPort write SetPort;
end;

implementation

{ TMyServerContext }

constructor TMyServerContext.Create(AConnection: TIdTCPConnection;
AYarn: TIdYarn; AList: TThreadList);
begin
inherited Create(AConnection, AYarn, AList);
FID:= 0;
end;

destructor TMyServerContext.Destroy;
begin

inherited;
end;

{ TMyServerClient }

constructor TMyServerClient.Create(AOwner: TMyServerClients);
begin
FContextA:= nil;
FContextB:= nil;
end;

destructor TMyServerClient.Destroy;
begin

inherited;
end;

procedure TMyServerClient.SetContextA(const Value: TMyServerContext);
begin
FContextA := Value;
FContextA.FID:= ID;
end;

procedure TMyServerClient.SetContextB(const Value: TMyServerContext);
begin
FContextB := Value;
FContextB.FID:= ID;
end;

{ TMyServerClients }

constructor TMyServerClients.Create(AOwner: TMyServer);
begin
inherited Create;
FOwner:= AOwner;
FItems:= TThreadList.Create;
end;

destructor TMyServerClients.Destroy;
begin
Clear;
FItems.Free;
inherited;
end;

function TMyServerClients.GetClient(ID: Integer): TMyServerClient;
var
L: TList;
X: Integer;
begin
Result:= nil;
L:= FItems.LockList;
try
for X := 0 to L.Count - 1 do begin
if TMyServerClient(L[X]).ID = ID then begin
Result:= TMyServerClient(L[X]);
Break;
end;
end;
finally
FItems.UnlockList;
end;
end;

function TMyServerClients.GetItem(Index: Integer): TMyServerClient;
var
L: TList;
begin
Result:= nil;
L:= FItems.LockList;
try
Result:= TMyServerClient(L[Index]);
finally
FItems.UnlockList;
end;
end;

function TMyServerClients.IndexOfID(const ID: Integer): Integer;
var
L: TList;
X: Integer;
begin
Result:= -1;
L:= FItems.LockList;
try
for X := 0 to L.Count - 1 do begin
if TMyServerClient(L[X]).ID = ID then begin
Result:= X;
Break;
end;
end;
finally
FItems.UnlockList;
end;
end;

function TMyServerClients.Add: TMyServerClient;
var
L: TList;
begin
Result:= nil;
L:= FItems.LockList;
try
Result:= TMyServerClient.Create(Self);
L.Add(Result);
Result.FID:= FOwner.NewID;
finally
FItems.UnlockList;
end;
end;

function TMyServerClients.Add(ContextA: TMyServerContext): TMyServerClient;
begin
Result:= Add;
Result.ContextA:= ContextA;
ContextA.FID:= Result.ID;
end;

procedure TMyServerClients.Delete(const Index: Integer);
var
L: TList;
begin
L:= FItems.LockList;
try
TMyServerClient(L[Index]).Free;
L.Delete(Index);
finally
FItems.UnlockList;
end;
end;

procedure TMyServerClients.DeleteID(const ID: Integer);
var
L: TList;
I: Integer;
begin
I:= IndexOfID(ID);
if I >= 0 then begin
L:= FItems.LockList;
try
TMyServerClient(L[I]).Free;
L.Delete(I);
finally
FItems.UnlockList;
end;
end else begin
//ID not found
end;
end;

procedure TMyServerClients.Clear;
var
L: TList;
begin
L:= FItems.LockList;
try
while L.Count > 0 do begin
TMyServerClient(L[0]).Free;
L.Delete(0);
end;
finally
FItems.UnlockList;
end;
end;

function TMyServerClients.Count: Integer;
var
L: TList;
begin
Result:= 0;
L:= FItems.LockList;
try
Result:= L.Count;
finally
FItems.UnlockList;
end;
end;

{ TMyServer }

constructor TMyServer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FActive:= False;
FLastID:= 0;
FClients:= TMyServerClients.Create(Self);
FServer:= TIdTCPServer.Create(nil);
FServer.ContextClass:= TMyServerContext;
FServer.OnContextCreated:= SvrContextCreated;
FServer.OnConnect:= SvrConnect;
FServer.OnDisconnect:= SvrDisconnect;
FServer.OnExecute:= SvrExecute;
FPortA:= 2701;
FPortB:= 2805;
end;

destructor TMyServer.Destroy;
begin
Active:= False;
FServer.Free;
FClients.Free;
inherited;
end;

function TMyServer.GetLocalAddress: String;
type
pu_long = ^u_long;
var
varTWSAData: TWSAData;
varPHostEnt: PHostEnt;
varTInAddr: TInAddr;
namebuf: array[0..255] of AnsiChar;
begin
If WSAStartup($101, varTWSAData) <> 0 then
Result:= ''
else begin
gethostname(namebuf,sizeof(namebuf));
varPHostEnt := gethostbyname(namebuf);
varTInAddr.S_addr := u_long(pu_long(varPHostEnt^.h_addr_list^)^);
Result:= inet_ntoa(varTInAddr);
end;
WSACleanup;
end;

function TMyServer.NewID: Integer;
begin
Inc(FLastID);
Result:= FLastID;
end;

procedure TMyServer.SetActive(const Value: Bool);
var
B: TIdSocketHandle;
IP: String;
begin
if Value then begin
if not FActive then begin
FActive:= True;
//Clear previous bindings
FServer.Bindings.Clear;
//Temporarily copy IP for lighter weight
IP:= LocalAddress;
//Create binding for port a
B:= FServer.Bindings.Add;
B.IP:= IP;
B.Port:= FPortA;
//Create binding for port b
B:= FServer.Bindings.Add;
B.IP:= IP;
B.Port:= FPortB;
//Active server
FServer.Active:= True;
end;
end else begin
if FActive then begin
FActive:= False;
FServer.Active:= False;
FClients.Clear;
end;
end;
end;

procedure TMyServer.SetPortA(const Value: Integer);
begin
if not FServer.Active then begin
FPortA := Value;
end else begin
raise Exception.Create('Cannot set port when server is active!');
end;
end;

procedure TMyServer.SetPortB(const Value: Integer);
begin
if not FServer.Active then begin
FPortB := Value;
end else begin
raise Exception.Create('Cannot set port when server is active!');
end;
end;

procedure TMyServer.SvrConnect(AContext: TIdContext);
var
C: TMyServerClient;
T: TMyServerContext;
begin
T:= TMyServerContext(AContext);
C:= FClients.Client[T.ID];
if T.Binding.Port = FPortA then begin

end else
if T.Binding.Port = FPortB then begin

end;
end;

procedure TMyServer.SvrContextCreated(AContext: TIdContext);
var
C: TMyServerClient;
T: TMyServerContext;
begin
T:= TMyServerContext(AContext);
if T.Binding.Port = FPortA then begin
C:= FClients.Add(TMyServerContext(AContext));
end else
if T.Binding.Port = FPortB then begin
//C:= FClients.Client[T.ID];
//C.ContextB:= T;
end;
end;

procedure TMyServer.SvrDisconnect(AContext: TIdContext);
var
C: TMyServerClient;
T: TMyServerContext;
begin
T:= TMyServerContext(AContext);
C:= FClients.Client[T.ID];
if T.Binding.Port = FPortA then begin
FClients.DeleteID(T.ID);
end else
if T.Binding.Port = FPortB then begin

end;
end;

procedure TMyServer.SvrExecute(AContext: TIdContext);
var
R: String;
C: TMyServerClient;
T: TMyServerContext;
I: Integer;
begin
T:= TMyServerContext(AContext);
if T.Binding.Port = FPortA then begin
C:= FClients.Client[T.ID];
T.Connection.IOHandler.ReadByte; // skip $02
R:= T.Connection.IOHandler.ReadLn(#03, 5000);
if R = 'GetID' then begin
T.Connection.IOHandler.Write(Byte($02));
T.Connection.IOHandler.Write(IntToStr(T.ID));
T.Connection.IOHandler.Write(Byte($03));
end else
if R = 'GetPortB' then begin
T.Connection.IOHandler.Write(Byte($02));
T.Connection.IOHandler.Write(IntToStr(FPortB));
T.Connection.IOHandler.Write(Byte($03));
end else begin
//Unrecognized command
end;
end else
if T.Binding.Port = FPortB then begin
T.Connection.IOHandler.ReadByte; // skip $02
R:= T.Connection.IOHandler.ReadLn(#03, 5000);
if R = 'GetDateTime' then begin
T.Connection.IOHandler.Write(Byte($02));
T.Connection.IOHandler.Write(
FormatDateTime('mm/dd/yyyy hh:nn:ss.zzz', Now));
T.Connection.IOHandler.Write(Byte($03));
end else
if Pos('SetID=', R) = 1 then begin
Delete(R, 1, 6);
I:= StrToIntDef(R, 0);
if I > 0 then begin
C:= FClients.Client[I];
C.ContextB:= T;
end else begin
//Invalid ID
end;
end else
if R = 'SomeOtherCommand' then begin
//Handle SomeOtherCommand...
end else begin
//Unrecognized command
end;
end;
end;

{ TMyClient }

constructor TMyClient.Create(AOwner: TComponent);
begin
inherited;
FID:= 0;
FClientA:= TIdTCPClient.Create(nil);
FClientA.OnConnected:= AConnected;
FClientA.OnDisconnected:= ADisconnected;
FClientB:= TIdTCPClient.Create(nil);
FClientB.OnConnected:= BConnected;
FClientB.OnDisconnected:= BDisconnected;
FHost:= 'LocalHost';
FPort:= 2701;
end;

destructor TMyClient.Destroy;
begin

inherited;
end;

procedure TMyClient.Connect;
var
R: String;
begin
FClientA.Host:= FHost;
FClientA.Port:= FPort;
FClientB.Host:= FHost;
FClientA.Connect;
//Ask server for ID
FClientA.IOHandler.Write(Byte($02));
FClientA.IOHandler.Write('GetID');
FClientA.IOHandler.Write(Byte($03));
//Read response
FClientA.IOHandler.ReadByte; // skip $02
R:= FClientA.IOHandler.ReadLn(#03, 5000);
FID:= StrToIntDef(R, 0);
//Ask server for Port B
FClientA.IOHandler.Write(Byte($02));
FClientA.IOHandler.Write('GetPortB');
FClientA.IOHandler.Write(Byte($03));
//Read response
FClientA.IOHandler.ReadByte; // skip $02
R:= FClientA.IOHandler.ReadLn(#03, 5000);
FPortB:= StrToIntDef(R, 0);
//Validate what was received
if FPortB > 0 then begin
FClientB.Port:= FPortB;
FClientB.Connect;
FClientB.IOHandler.Write(Byte($02));
FClientB.IOHandler.Write('SetID='+IntToStr(FID));
FClientB.IOHandler.Write(Byte($03));
end else begin
Disconnect;
raise Exception.Create('Unable to connect to Port B.');
end;
end;

procedure TMyClient.Disconnect;
begin
FClientB.Disconnect;
FClientA.Disconnect;
FID:= 0;
end;

function TMyClient.GetDateTime: TDateTime;
var
R: String;
begin
Result:= 0;
if FClientB.Connected then begin
//Send request for date/time
FClientB.IOHandler.Write(Byte($02));
FClientB.IOHandler.Write('GetDateTime');
FClientB.IOHandler.Write(Byte($03));
//Read response from server
FClientB.IOHandler.ReadByte; // skip $02
R:= FClientB.IOHandler.ReadLn(#03);
Result:= StrToDateTime(R);
end else begin
raise Exception.Create('Not connected!');
end;
end;

procedure TMyClient.SetActive(const Value: Bool);
begin
if Value then begin
if not FActive then begin
Connect;
end;
end else begin
if FActive then begin
Disconnect;
end;
end;
end;

procedure TMyClient.AConnected(Sender: TObject);
begin
//Main socket connected
end;

procedure TMyClient.ADisconnected(Sender: TObject);
begin
//Main socket disconnected
end;

procedure TMyClient.BConnected(Sender: TObject);
begin
//Additional socket connected
end;

procedure TMyClient.BDisconnected(Sender: TObject);
begin
//Additional socket disconnected
end;

procedure TMyClient.SetHost(const Value: String);
begin
FHost := Value;
end;

procedure TMyClient.SetPort(const Value: Integer);
begin
FPort := Value;
end;

end.

From here on, the comments in the code should tell the rest of the story. What the actual test does is when you click this button, it will simply ask the server for the current date/time (a real implementation of this server would be for much larger scale projects, date/time does not require this complexity). When you click the button, here's the basic steps of what it does:

- Activates both ports on server
- Client connects to the first port
- Server creates a new object representing the entire client with a session ID
- Client asks server for its session ID
- Server sends client the session ID
- Client asks server for the secondary port
- Server sends client the secondary port
- Client connects to secondary port
- Server combines both connections into one client object
- Client asks server through second port for current date/time
- Server sends back current date/time
- Client shows response in a message box
- Client disconnects from server
- Server deactivates

HINT - If you have any problems with the form not doing anything, make sure the 3 event handlers are linked in the DFM.

Back to Embarcadero: Delphi FAQ Index
Back to Embarcadero: Delphi Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close