{*******************************************************}
{                                                       }
{  Responsive Software     http://www.responsive.co.nz  }
{                                                       }
{  Copyright (c) 2003-2006 Responsive Software Limited  }
{                                                       }
{*******************************************************}

unit CommunicatorUnit;

interface

uses
  Classes, SysUtils, ScktComp, SyncObjs;

type
  // the TCommunicator class is only used in a standard peer-to-peer
  // configuration and is not used when the application is running as either
  // a client or a server 
  // the TCommunicator class is used to send data and receive data
  // from the same application operating on other workstations it
  // is really just a wrapper for two other classes TSender and TReceiver
  // which handle the sending and receiving of data respectively
  // sending data is handled by a separate thread created and owned by the
  // TSender class and uses blocking client sockets
  // receiving data is handled by a blocking server socket created and
  // owned by the TReceiver class which spawns a separate thread for each
  // connection received
  TCommunicator = class;
  TSender = class;
  TReceiver = class;

  // this class is the main thread used by the TSender class
  TSenderMainThread = class(TThread)
  private
    FSender : TSender; // reference to TSender object using this thread
  public
    constructor Create
      (Sender : TSender);
    procedure Execute; override;
  end;

  // this class represents a client socket used to send data
  // to another workstation running the application
  TWorkstationClientSocket = class
  private
    FIPAddress : string;
    FClientSocket : TClientSocket;
    FTimeForNextAttempt : TDateTime;
  public
    constructor Create
      (IPAddress : string);
    destructor Destroy; override;
    function IPAddress : string;
    function ClientSocket : TClientSocket;
    function TimeForNextAttempt : TDateTime;
    procedure SetTimeForNextAttempt
      (TimeForNextAttempt : TDateTime);
  end;

  // this class contains a single data item to be sent
  // to another workstation
  TDataToSendItem = class
  private
    FData : string;
    FId : integer;  // used to uniquely mark all messages sent so that they can
                   // continue to be resent until confirmation is received
    FTimeLastSent : TDateTime;  // used to record the last time the message was
                          // sent so that we can put a time delay between sends
  public
    constructor Create
      (Data : string;
       Sender : TSender);
    function Data : string;
    function Id : integer;
    function TimeLastSent : TDateTime;
    procedure SetTimeLastSent
      (TimeLastSent : TDateTime);
  end;

  // this class contains the data to be sent to the other
  // workstation
  TWorkstationDataToSend = class
  private
    FWorkstationConfigurationId : int64;
    FDataToSend : TList;
  public
    constructor Create
      (WorkstationConfigurationId : int64);
    destructor Destroy; override;
    function WorkstationConfigurationId : int64;
    function DataToSend : TList;
  end;

  // this class creates and maintains client socket connections
  // to all other workstations where the application is running
  // and is responsible for managing and sending the data
  TSender = class
  private
    FMainThread : TThread;
    // used internally and only accessed by FMainThread
    FWorkstationClientSockets : TList;
    FThisWorkstationId : int64;
    // accessed by both FMainThread and the application
    // so access must be controlled by critical sections
    FWorkstationDataToSends : TList; 
    FWorkstationDataToSendsLock : TCriticalSection;
    FStatusString : string;
    FStatusStringLock : TCriticalSection;
    // accessed by the threads in the receiver to indicate that a
    // confirmation message should be sent back to the sending workstation
    FWorkstationIdDataIds : TList;
    FWorkstationIdDataIdsLock : TCriticalSection;
    // used to give each data item a unique id
    FNextDataToSendId : integer;
    FNextDataToSendIdLock : TCriticalSection;
    
    function GenerateDataToSendId : integer;
  public
    // called internally by FMainThread
    procedure MaintainConnections;
    procedure SendDataToClientSockets;
    procedure UpdateStatusString;
    // these functions are the only ones which should be accessed
    // by the applications main thread
    constructor Create;
    destructor Destroy; override;
    procedure SendData
      (Data : string;
       WorkstationId : int64);
    function StatusString : string;
    // these function is accessed by the receiver server socket threads
    procedure SendConfirmation
      (WorkstationId : int64;
       DataId : integer);
    procedure ConfirmationReceived
      (WorkstationId : int64;
       DataId : integer);
  end;

  // this class is the thread spawned by the server socket
  // within the TReceiver class
  // there is one created for each new connection received
  TReceiverThread = class(TServerClientThread)
  private
    FReceiver : TReceiver;  // ref to TReceiver object which spawned this thread
    FSender : TSender; // ref to TSender object associated with TReceiver
  public
    constructor Create
      (CreateSuspended: Boolean;
       ASocket: TServerClientWinSocket;
       Receiver : TReceiver;
       Sender : TSender);
    procedure ClientExecute; override;
  end;

  // this class simply records the last data id received from
  // the associated workstation id so that we can eliminate
  // any duplicate data
  TWorkstationIdDataId = class
    WorkstationId : int64;
    DataId : integer;
  end;

  // this class creates the server socket and manages any data
  // received through it
  TReceiver = class
  private
    FServerSocket : TServerSocket;
    FDataReceived : TStringList;
    FDataReceivedLock : TCriticalSection;
    FWorkstationIdDataIds : TList;
    FWorkstationIdDataIdsLock : TCriticalSection;

    FSender : TSender; // reference to associated sender so that we can
                       // send confirmation messages
    procedure GetThread
      (Sender : TObject;
       ClientSocket : TServerClientWinSocket;
       var SocketThread : TServerClientThread);
  public
    constructor Create
      (Sender : TSender);
    destructor Destroy; override;
    procedure AddToDataReceived
      (Str : string;
       WorkstationId : int64;
       DataId : integer);
    function ReceiveData : string;
    function StatusString : string;
  end;

  // this class is a wrapper for the TSender and TReceiver objects
  TCommunicator = class
    FSender : TSender;
    FReceiver : TReceiver;
    FLocalData : TStringList;  // used to simulate communications locally
    FLocalMode : boolean;      // during development
  public
    constructor Create
      (LocalMode : boolean);
    destructor Destroy; override;
    function StatusString : string;
    procedure SendData
      (Data : string;
       WorkstationId : int64);
    function ReceiveData : string;
  end;

implementation

uses
  Windows, DateUtils, 
  Globals, DatabaseObjects, DatabaseManager, GeneralUtilities;

{***** TSenderMainThread methods **********************************************}

constructor TSenderMainThread.Create
  (Sender : TSender);
begin
  // create thread and run immediately
  inherited Create(false);
  // record reference to the sender object to which this thread belongs
  FSender := Sender;
end;

procedure TSenderMainThread.Execute;
begin
  while true do
  begin
    // call the sender functions repeatedly while thread is running
    FSender.MaintainConnections;
    FSender.SendDataToClientSockets;
    FSender.UpdateStatusString;
    // give other threads a chance
    Sleep(1);
    // check termination flag 
    if Terminated then
      Exit;
  end;
end;

{***** TWorkstationClientSocket methods ***************************************}

constructor TWorkstationClientSocket.Create
  (IPAddress : string);
begin
  FIPAddress := IPAddress;
  // create the client socket
  FClientSocket := TClientSocket.Create(nil);
  FClientSocket.Address := FIPAddress;
  FClientSocket.Port := GlobalConfiguration.PortNumber;
  // use synchronously within the thread
  FClientSocket.ClientType := ctBlocking;
end;

destructor TWorkstationClientSocket.Destroy;
begin
  try
    FClientSocket.Close;
  except
    // ignore any exception which may occur when closing
  end;
  FClientSocket.Free;
end;

function TWorkstationClientSocket.IPAddress : string;
begin
  Result := FIPAddress;
end;

function TWorkstationClientSocket.ClientSocket : TClientSocket;
begin
  Result := FClientSocket;
end;

function TWorkstationClientSocket.TimeForNextAttempt : TDateTime;
begin
  Result := FTimeForNextAttempt;
end;

procedure TWorkstationClientSocket.SetTimeForNextAttempt
  (TimeForNextAttempt : TDateTime);
begin
  FTimeForNextAttempt := TimeForNextAttempt;
end;

{***** TDataToSendItem methods ************************************************}

constructor TDataToSendItem.Create
  (Data : string;
   Sender : TSender);
begin
  FData := Data;
  FId := Sender.GenerateDataToSendId;
end;

function TDataToSendItem.Data : string;
begin
  Result := FData;
end;

function TDataToSendItem.Id : integer;
begin
  Result := FId;
end;

function TDataToSendItem.TimeLastSent : TDateTime;
begin
  Result := FTimeLastSent;
end;

procedure TDataToSendItem.SetTimeLastSent
  (TimeLastSent : TDateTime);
begin
  FTimeLastSent := TimeLastSent;
end;

{***** TWorkstationDataToSend methods *****************************************}

constructor TWorkstationDataToSend.Create
  (WorkstationConfigurationId : int64);
begin
  FWorkstationConfigurationId := WorkstationConfigurationId;
  FDataToSend := TList.Create;
end;

destructor TWorkstationDataToSend.Destroy;
begin
  DestroyList(FDataToSend);
end;

function TWorkstationDataToSend.WorkstationConfigurationId : int64;
begin
  Result := FWorkstationConfigurationId;
end;

function TWorkstationDataToSend.DataToSend : TList;
begin
  Result := FDataToSend;
end;

{***** TSender methods ********************************************************}

constructor TSender.Create;
var
  WorkstationConfigurations : TDatabaseObjectCollection;
  OtherWorkstationConfiguration : TWorkstationConfiguration;
  WorkstationClientSocket : TWorkstationClientSocket;
  WorkstationDataToSend : TWorkstationDataToSend;
  WorkstationIdDataId : TWorkstationIdDataId;
  i : integer;
begin
  // initialise the id generator
  FNextDataToSendId := 10000;
  // create a client socket for each workstation listed in the
  // database other than this one
  // and at the same time create a list of data to send
  FWorkstationClientSockets := TList.Create;
  FWorkstationDataToSends := TList.Create;
  FWorkstationIdDataIds := TList.Create;
  // record the current workstation id so it can be accessed from FMainThread
  FThisWorkstationId := WorkstationConfiguration.Id;
  // get the workstations from the database
  WorkstationConfigurations := nil;
  AcquireDatabaseCriticalUpdate;
  try
    LoadAllDatabaseObjects(WorkstationConfigurations,TWorkstationConfiguration);
  finally
    ReleaseDatabaseCriticalUpdate;
  end;
  // go through each workstation in turn
  for i := 0 to WorkstationConfigurations.Count - 1 do
  begin
    OtherWorkstationConfiguration :=
      TWorkstationConfiguration(WorkstationConfigurations[i]);
    if (OtherWorkstationConfiguration.Id <> WorkstationConfiguration.Id)
      and (OtherWorkstationConfiguration.IPAddress <> '127.0.0.1')
      and (OtherWorkstationConfiguration.IPAddress <> WorkstationConfiguration.IPAddress)
      and (OtherWorkstationConfiguration.IPAddress <> '') then
    begin
      // create the client socket
      WorkstationClientSocket := TWorkstationClientSocket.Create(
        OtherWorkstationConfiguration.IPAddress);
      FWorkstationClientSockets.Add(WorkstationClientSocket);
      // create the data to send
      WorkstationDataToSend := TWorkstationDataToSend.Create(
        OtherWorkstationConfiguration.Id);
      FWorkstationDataToSends.Add(WorkstationDataToSend);
      // create the TWorkstationIdDataId
      WorkstationIdDataId := TWorkstationIdDataId.Create;
      WorkstationIdDataId.WorkstationId := OtherWorkstationConfiguration.Id;
      WorkstationIdDataId.DataId := 0;
      FWorkstationIdDataIds.Add(WorkstationIdDataId);
    end;
  end;
  // destroy collection from database
  WorkstationConfigurations.Free;
  // create thread control objects
  FWorkstationDataToSendsLock := TCriticalSection.Create;
  FStatusStringLock := TCriticalSection.Create;
  FNextDataToSendIdLock := TCriticalSection.Create;
  FWorkstationIdDataIdsLock := TCriticalSection.Create;
  // initialise the status string now before thread starts running
  UpdateStatusString;
  // create the main thread and let it run
  FMainThread := TSenderMainThread.Create(Self);
end;

destructor TSender.Destroy;
begin
  // first kill the main thread before doing anything else
  FMainThread.Terminate;
  FMainThread.WaitFor;
  // destroy main thread
  FMainThread.Free;
  // destroy thread control objects
  FStatusStringLock.Free;
  FWorkstationDataToSendsLock.Free;
  FNextDataToSendIdLock.Free;
  FWorkstationIdDataIdsLock.Free;
  // destroy data to sends
  DestroyList(FWorkstationDataToSends);
  // destroy client sockets
  DestroyList(FWorkstationClientSockets);
  // destroy list of TWorkstationIdDataId's
  DestroyList(FWorkstationIdDataIds);
end;

procedure TSender.MaintainConnections;
var
  i : integer;
  WorkstationClientSocket : TWorkstationClientSocket;
  StartTime : TDateTime;
  FinishTime : TDateTime;
begin
  // check each client socket and if it is not connected then
  // attempt to connect
  for i := 0 to FWorkstationClientSockets.Count - 1 do
  begin
    WorkstationClientSocket :=
      TWorkstationClientSocket(FWorkstationClientSockets[i]);
    if (not WorkstationClientSocket.ClientSocket.Active)
      and (Now > WorkstationClientSocket.TimeForNextAttempt) then
    begin
      StartTime := Now;
      try
        WorkstationClientSocket.ClientSocket.Active := true;
      except
        FinishTime := Now;
        // if unsuccesful and took longer than 15 seconds to report failure
        // then don't try again for at least 5 minutes as the computer is
        // probably not on the network
        if FinishTime > IncMilliSecond(StartTime,15 * 1000) then
          WorkstationClientSocket.SetTimeForNextAttempt(
            IncMilliSecond(Now,5 * 60 * 1000))
        // if unsuccesful and took longer than 1/2 second to report failure
        // then don't try again for at least 10 seconds as the computer is
        // probably on the network but the application is probably not running
        else if FinishTime > IncMilliSecond(StartTime,500) then
          WorkstationClientSocket.SetTimeForNextAttempt(
            IncMilliSecond(Now,10 * 1000))
        else
          // otherwise just keep trying every second
          WorkstationClientSocket.SetTimeForNextAttempt(IncMilliSecond(Now,1000));
      end;
    end;
  end;
end;

procedure TSender.SendDataToClientSockets;
var
  i : integer;
  WorkstationClientSocket : TWorkstationClientSocket;
  DataToSend : TList;
  Str : string;
  DataToSendItem : TDataToSendItem;
  Data : string;
  WorkstationIdDataId : TWorkstationIdDataId;
begin
  // check each client socket and if there is
  // some data to send then attempt to send it
  for i := 0 to FWorkstationClientSockets.Count - 1 do
  begin
    WorkstationClientSocket :=
      TWorkstationClientSocket(FWorkstationClientSockets[i]);
    // acquire lock on data to send
    FWorkstationDataToSendsLock.Acquire;
    try
      DataToSend :=
        TWorkstationDataToSend(FWorkstationDataToSends[i]).DataToSend;
      if DataToSend.Count > 0 then
      begin
        // if not active then clear any queued data
        if not WorkstationClientSocket.ClientSocket.Active then
          ClearList(DataToSend)
        else begin
          try
            DataToSendItem := TDataToSendItem(DataToSend[0]);
            // only send if a delay of at least 5 seconds
            // has occurred since the last attempt
            if Now > IncMillisecond(DataToSendItem.TimeLastSent,5000) then
            begin
              // prepend the workstation id and the data item id
              Str := '(' + IntToStr(FThisWorkstationId) + ')['
                    + IntToStr(DataToSendItem.Id) + ']' + DataToSendItem.Data;
              // send string through socket but prepend the length in
              // curly brackets so that the receiving socket knows how
              // much data to expect
              Data := '{' + IntToStr(Length(Str)) + '}' + Str;
              WorkstationClientSocket.ClientSocket.Socket.SendText(Data);
              DataToSendItem.SetTimeLastSent(Now);
              // give connection a chance to recover
              Sleep(10);
              // if connection is no longer active after sending then we must
              // have lost the connection so clear all remaining data
              if not WorkstationClientSocket.ClientSocket.Active then
                ClearList(DataToSend);
            end;
          except
            // if an exception occurs then just do nothing but leave
            // to try again next time around
          end;
        end;
      end;
    finally
      FWorkstationDataToSendsLock.Release;
    end;
    // check whether a confirmation message should be sent
    FWorkstationIdDataIdsLock.Acquire;
    try
      WorkstationIdDataId := FWorkstationIdDataIds[i];
      if WorkstationIdDataId.DataId <> 0 then
      begin
        // if not active then don't bother with confirmation message
        if not WorkstationClientSocket.ClientSocket.Active then
          WorkstationIdDataId.DataId := 0
        else begin
          try
            // confirmation consists of the workstation id
            // and the data item id with no data
            Str := '(' + IntToStr(FThisWorkstationId) + ')['
              + IntToStr(WorkstationIdDataId.DataId) + ']';
            // send string through socket but prepend the length in
            // curly brackets so that the receiving socket knows how
            // much data to expect
            Data := '{' + IntToStr(Length(Str)) + '}' + Str;
            WorkstationClientSocket.ClientSocket.Socket.SendText(Data);
            // only send confirmation once because we have no way of knowing
            // whether it was received or not, if it wasn't the client will
            // resend the data and trigger another confirmation anyway
            WorkstationIdDataId.DataId := 0;
          except
            // if an exception occurs then just do nothing but leave
            // to try again next time around
          end;
        end;
      end;
    finally
      FWorkstationIdDataIdsLock.Release;
    end;
  end;
end;

procedure TSender.UpdateStatusString;
var
  i : integer;
  WorkstationClientSocket : TWorkstationClientSocket;
  DataToSend : TList;
  Str : string;
begin
  Str := '';
  // check each client socket and record its status in the status string
  // together with the count of data waiting to be sent
  for i := 0 to FWorkstationClientSockets.Count - 1 do
  begin
    WorkstationClientSocket :=
      TWorkstationClientSocket(FWorkstationClientSockets[i]);
    // record open/closed status
    if WorkstationClientSocket.ClientSocket.Active then
      Str := Str + ' O/'
    else
      Str := Str + ' C/';
    // record IP address
    Str := Str + WorkstationClientSocket.IPAddress;
    // record data count
    FWorkstationDataToSendsLock.Acquire;
    try
      DataToSend :=
        TWorkstationDataToSend(FWorkstationDataToSends[i]).DataToSend;
      Str := Str + '/' + IntToStr(DataToSend.Count);
    finally
      FWorkstationDataToSendsLock.Release;
    end;
  end;
  // update the status string
  FStatusStringLock.Acquire;
  try
    FStatusString := Str;
  finally
    FStatusStringLock.Release;
  end;
end;

// this procedure is available to the application for
// sending data to one or all workstations
procedure TSender.SendData
  (Data : string;
   WorkstationId : int64);
var
  i : integer;
  WorkstationDataToSend : TWorkstationDataToSend;
begin
  // place the data into the appropriate data to sends
  FWorkstationDataToSendsLock.Acquire;
  try
    for i := 0 to FWorkstationDataToSends.Count - 1 do
    begin
      WorkstationDataToSend :=
        TWorkstationDataToSend(FWorkstationDataToSends[i]);
      if (WorkstationId = 0) or
        (WorkstationId = WorkstationDataToSend.WorkstationConfigurationId) then
        WorkstationDataToSend.DataToSend.Add(TDataToSendItem.Create(Data,Self));
    end;
  finally
    FWorkstationDataToSendsLock.Release;
  end;
end;

function TSender.StatusString : string;
begin
  FStatusStringLock.Acquire;
  try
    Result := FStatusString;
  finally
    FStatusStringLock.Release;
  end;
end;

procedure TSender.SendConfirmation
  (WorkstationId : int64;
   DataId : integer);
var
  i : integer;
  WorkstationIdDataId : TWorkstationIdDataId;
begin
  if DataId <> 0 then
  begin
    FWorkstationIdDataIdsLock.Acquire;
    try
      for i := 0 to FWorkstationIdDataIds.Count - 1 do
      begin
        WorkstationIdDataId := TWorkstationIdDataId(FWorkstationIdDataIds[i]);
        if WorkstationIdDataId.WorkstationId = WorkstationId then
        begin
          WorkstationIdDataId.DataId := DataId;
          Break;
        end;
      end;
    finally
      FWorkstationIdDataIdsLock.Release;
    end;
  end;
end;

procedure TSender.ConfirmationReceived
  (WorkstationId : int64;
   DataId : integer);
var
  i : integer;
  WorkstationDataToSend : TWorkstationDataToSend;
  DataToSend : TList;
begin
  // remove the messages from the data to send up to and including this id
  FWorkstationDataToSendsLock.Acquire;
  try
    for i := 0 to FWorkstationDataToSends.Count - 1 do
    begin
      WorkstationDataToSend :=
        TWorkstationDataToSend(FWorkstationDataToSends[i]);
      if WorkstationId = WorkstationDataToSend.WorkstationConfigurationId then
      begin
        DataToSend := WorkstationDataToSend.DataToSend;
        while (DataToSend.Count > 0)
          and (TDataToSendItem(DataToSend[0]).Id <= DataId) do
        begin
          TDataToSendItem(DataToSend[0]).Free;
          DataToSend.Delete(0);
        end;
        Break;
      end;
    end;
  finally
    FWorkstationDataToSendsLock.Release;
  end;
end;

function TSender.GenerateDataToSendId : integer;
begin
  FNextDataToSendIdLock.Acquire;
  try
    Result := FNextDataToSendId;
    Inc(FNextDataToSendId);
  finally
    FNextDataToSendIdLock.Release;
  end;
end;

{***** TReceiverThread methods ************************************************}

constructor TReceiverThread.Create
  (CreateSuspended: Boolean;
   ASocket: TServerClientWinSocket;
   Receiver : TReceiver;
   Sender : TSender);
begin
  FReceiver := Receiver;
  FSender := Sender;
  inherited Create(CreateSuspended,ASocket);
end;

procedure TReceiverThread.ClientExecute;
const
  MaxBytesRead = 1024;
var
  WinSocketStream : TWinSocketStream;
  Buffer : string;
  ExpectedLengthStr : string;
  ExpectedLength : integer;
  ReceivedData : string;
  ReceivedString : string;
  BytesRead : integer;
  WorkstationIdStr : string;
  WorkstationId : int64;
  DataIdStr : string;
  DataId : integer;
begin
  // continue reading from socket even if there is no data
  // and only terminate if the connection is lost
  // set time-out value to 1/2 second
  WinSocketStream := TWinSocketStream.Create(ClientSocket,500);
  ExpectedLength := 0;
  ReceivedData := '';
  BytesRead := 0;
  try
    while true do
    begin
      // check connection and if disconnected then terminate the thread
      if not ClientSocket.Connected then
      begin
        Terminate;
        Exit;
      end;
      // initialise receive buffer
      SetLength(Buffer,MaxBytesRead);
      FillChar(Buffer[1],MaxBytesRead,0);
      // read data from socket
      if WinSocketStream.WaitForData(100000) then
      begin
        try
          BytesRead := WinSocketStream.Read(Buffer[1], MaxBytesRead);
          // if no data then terminate the thread as we must have lost the
          // connection
          if BytesRead = 0 then
          begin
            Terminate;
            Exit;
          end;
        except
          // if an error occurs then terminate the thread
          Terminate;
          Exit;
        end;
      end else
        BytesRead := 0;
        
      if BytesRead > 0 then
      begin
        SetLength(Buffer,BytesRead);
        // add data received to received data string
        ReceivedData := ReceivedData + Buffer;
        // now process all data received
        while (Length(ReceivedData) > ExpectedLength) do
        begin
          // look for expected data length between two curly brackets
          if ExpectedLength = 0 then
          begin
            // if we have an expected length then extract this if it is
            // available and then remove this from the beginning of the string
            if (ReceivedData[1] = '{') and (Pos('}',ReceivedData) <> 0) then
            begin
              ExpectedLengthStr :=
                Copy(ReceivedData,2,Pos('}', ReceivedData)-2);
              ExpectedLength := StrToIntDef(ExpectedLengthStr,0);
              Delete(ReceivedData,1,Pos('}', ReceivedData));
            // otherwise if the first character is not '{' then
            // discard the data as something is seriously wrong
            end else if ReceivedData[1] <> '{' then
              ReceivedData := ''
            // otherwise do nothing but continue to receive data til we get '}'
            else
              // do nothing, just break out of loop
              Break;
          end;
          // if we are expecting data then check whether we have it all yet
          if (ExpectedLength > 0)
            and (Length(ReceivedData) >= ExpectedLength) then
          begin
            // take only the number of bytes expected and leave the rest
            // because this must belong to the next message
            ReceivedString := Copy(ReceivedData,1,ExpectedLength);
            // extract sending workstation id and data id
            WorkstationIdStr :=
              Copy(ReceivedString,2,Pos(')',ReceivedString)-2);
            WorkstationId := StrToInt64Def(WorkstationIdStr,0);
            Delete(ReceivedString,1,Pos(')',ReceivedString));
            DataIdStr := Copy(ReceivedString,2,Pos(']',ReceivedString)-2);
            DataId := StrToIntDef(DataIdStr,0);
            Delete(ReceivedString,1,Pos(']',ReceivedString));
            // if the remaining string is empty then this is
            // a confirmation message
            if ReceivedString = '' then
            begin
              // remove this from the data to be sent
              FSender.ConfirmationReceived(WorkstationId,DataId);
            end else begin
              // add the string to the received data
              FReceiver.AddToDataReceived(ReceivedString,WorkstationId,DataId);
              // send a confirmation message to the sending workstation
              FSender.SendConfirmation(WorkstationId,DataId);
            end;
            // leave remaining data
            Delete(ReceivedData,1,ExpectedLength);
            // reset expected length to zero
            ExpectedLength := 0;
          end;
        end;
      end;
      // give other threads a chance
      Sleep(1);
      // check termination flag
      if Terminated then
        Exit;
    end;
  finally
    WinSocketStream.Free;
  end;
end;

{***** TReceiver methods ******************************************************}

constructor TReceiver.Create
  (Sender : TSender);
var
  WorkstationConfigurations : TDatabaseObjectCollection;
  OtherWorkstationConfiguration : TWorkstationConfiguration;
  WorkstationIdDataId : TWorkstationIdDataId;
  i : integer;
begin
  // record reference to sender so that this can be accessed when sending
  // confirmation messages
  FSender := Sender;
  // create a list to store the incoming data
  FDataReceived := TStringList.Create;
  // create a list of TWorkstationIdDataId's
  // to record the id of the last message received
  FWorkstationIdDataIds := TList.Create;
  // get the workstations from the database
  WorkstationConfigurations := nil;
  AcquireDatabaseCriticalUpdate;
  try
    LoadAllDatabaseObjects(WorkstationConfigurations,TWorkstationConfiguration);
  finally
    ReleaseDatabaseCriticalUpdate;
  end;
  // go through each workstation in turn
  for i := 0 to WorkstationConfigurations.Count - 1 do
  begin
    OtherWorkstationConfiguration :=
      TWorkstationConfiguration(WorkstationConfigurations[i]);
    if OtherWorkstationConfiguration.Id <> WorkstationConfiguration.Id then
    begin
      // create the TWorkstationIdDataId
      WorkstationIdDataId := TWorkstationIdDataId.Create;
      WorkstationIdDataId.WorkstationId := OtherWorkstationConfiguration.Id;
      WorkstationIdDataId.DataId := 0;
      FWorkstationIdDataIds.Add(WorkstationIdDataId);
    end;
  end;
  // destroy collection from database
  WorkstationConfigurations.Free;
  // create a single server socket
  FServerSocket := TServerSocket.Create(nil);
  FServerSocket.Port := GlobalConfiguration.PortNumber;
  // create separate thread for each connection
  FServerSocket.ServerType := stThreadBlocking;
  // set event handler
  FServerSocket.OnGetThread := GetThread;
  // create thread control objects
  FDataReceivedLock := TCriticalSection.Create;
  FWorkstationIdDataIdsLock := TCriticalSection.Create;
  // open the socket to listen for incoming connections
  FServerSocket.Active := true;
end;

destructor TReceiver.Destroy;
begin
  // close connections
  FServerSocket.Close;
  // destroy server socket
  FServerSocket.Free;
  // destroy thread control objects
  FDataReceivedLock.Free;
  FWorkstationIdDataIdsLock.Free;
  // destroy string list
  FDataReceived.Free;
  // destroy list of TWorkstationIdDataId's
  DestroyList(FWorkstationIdDataIds);
end;

procedure TReceiver.GetThread
  (Sender : TObject;
   ClientSocket : TServerClientWinSocket;
   var SocketThread : TServerClientThread);
begin
  // create new thread for connection on request
  SocketThread := TReceiverThread.Create(false,ClientSocket,Self,FSender);
end;

procedure TReceiver.AddToDataReceived
  (Str : string;
   WorkstationId : int64;
   DataId : integer);
var
  i : integer;
  WorkstationIdDataId : TWorkstationIdDataId;
  AlreadyReceived : boolean;
begin
  // ignore empty strings
  if Str <> '' then
  begin
    AlreadyReceived := false;
    // check to see that we do not have a duplicate message
    if (WorkstationId <> 0) and (DataId <> 0) then
    begin
      FWorkstationIdDataIdsLock.Acquire;
      try
        for i := 0 to FWorkstationIdDataIds.Count - 1 do
        begin
          WorkstationIdDataId := TWorkstationIdDataId(FWorkstationIdDataIds[i]);
          if WorkstationIdDataId.WorkstationId = WorkstationId then
          begin
            if WorkstationIdDataId.DataId = DataId then
              AlreadyReceived := true
            else
              WorkstationIdDataId.DataId := DataId;
            Break;
          end;
        end;
      finally
        FWorkstationIdDataIdsLock.Release;
      end;
    end;
    // if it has not already been received then add it to the list
    if not AlreadyReceived then
    begin
      FDataReceivedLock.Acquire;
      try
        FDataReceived.Add(Str);
      finally
        FDataReceivedLock.Release;
      end;
    end;
  end;
end;

function TReceiver.ReceiveData : string;
begin
  FDataReceivedLock.Acquire;
  try
    if FDataReceived.Count > 0 then
    begin
      Result := FDataReceived[0];
      FDataReceived.Delete(0);
    end else
      Result := '';
  finally
    FDataReceivedLock.Release;
  end;
end;

function TReceiver.StatusString : string;
var
  Str : string;
begin
  Str := '';
  Str := Str + 'S/' + IntToStr(FServerSocket.Socket.ActiveConnections);
  FDataReceivedLock.Acquire;
  try
    Str := Str + '/' + IntToStr(FDataReceived.Count);
  finally
    FDataReceivedLock.Release;
  end;
  Result := Str;
end;

{***** TCommunicator methods **************************************************}

constructor TCommunicator.Create
  (LocalMode : boolean);
begin
  FLocalMode := LocalMode;
  if FLocalMode then
    // simulate by sending data to application running on local workstation
    FLocalData := TStringList.Create
  else begin
    FSender := TSender.Create;
    FReceiver := TReceiver.Create(FSender);
  end;
end;

destructor TCommunicator.Destroy;
begin
  FSender.Free;
  FReceiver.Free;
  FLocalData.Free;
end;

function TCommunicator.StatusString : string;
begin
  if FLocalMode then
    Result := 'Local/' + IntToStr(FLocalData.Count)
  else
    Result := FSender.StatusString + ' ' + FReceiver.StatusString;
end;

procedure TCommunicator.SendData
  (Data : string;
   WorkstationId : int64);
begin
  if FLocalMode then
    FLocalData.Add(Data)
  else begin
    // send to other workstations
    FSender.SendData(Data,WorkstationId);
    // also send to this workstation
    if FReceiver <> nil then
      FReceiver.AddToDataReceived(Data,0,0);
  end;
end;

function TCommunicator.ReceiveData : string;
begin
  if FLocalMode then
  begin
    if FLocalData.Count > 0 then
    begin
      Result := FLocalData[0];
      FLocalData.Delete(0);
    end else
      Result := '';
  end else
    Result := FReceiver.ReceiveData;
end;

{******************************************************************************}

end.