Navigation

More options

Style variation

Close Menu

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How do I bind multiple ports on an Indy server as if it were one client connection?

Networking

How do I bind multiple ports on an Indy server as if it were one client connection?

by djjd47130 Posted Jun 11, 2012 (Edited Jun 11, 2012)

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.

Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.

Accept Learn more…

Back

Top