Indy 10 Synchronize TIdTCPServer.onExecute with TIdSync

Question

I have a problem to sync the GUI of server. I'm using Delphi 2007 and Indy 10.1.5.

This is my case:
Server send to all connected client a hearbit (this is the message send from server --> "REQ|HeartBit")
Client response to server with "I'm alive" (this is the message send from client --> "ANS|USERNAME|I'm alive"
In onExecute procedure of the TIdTCPServer I want to see the answer of the client in a TlistView of server, so I have done like in this Link

When I start my application with two process client connected (that are runs in my PC) and send a hearbit message to clients, I see in the listview of server this situation:

two response message from Client2 (!?!?)
Where is my mistake?
Sorry for my poor English.
Thanks

The code of server side is this:

type
  TLog = class(TIdSync)
  private
    FMsg : string;
  protected
    procedure DoSynchronize; override;
  public
    constructor Create(const AMsg: String);
    //class procedure AddMsg(const AMsg: String);
  end;

  // procedure that add items in listview of server 
  procedure WriteListLog(aTimeStamp : TDateTime;strMessaggio: String);


implementation

procedure TLog.DoSynchronize;
begin

  WriteListLog(Now,FMsg);
end

procedure TForm1.tsExecute(AContext: TIdContext);
var
  Ctx: TMyContext;
  tmp : String;
  sync : Tlog;
begin
  Ctx := TMyContext(AContext);
  tmp := Ctx.Connection.IOHandler.ReadLn;
  sync := Tlog.Create(tmp);
  try
    sync.FMsg := tmp;
    sync.Synchronize;
  finally
    Sync.Free;
  end;
end;

Is it Correct?

procedure TForm1.tsExecute(AContext: TIdContext);
var
  Ctx: TMyContext;
  tmp : String;
  sync : Tlog;
begin
  Ctx := TMyContext(AContext);
  tmp := Ctx.Connection.IOHandler.ReadLn;
  Ctx.FContextList.LockList;
  try

    sync := Tlog.Create(tmp);
    try
      sync.FMsg := tmp;
      sync.Synchronize;
    finally
      Sync.Free;
    end;
  finally
    Ctx.FContextList.UnlockList;
  end;
end;

Update

In my project, the listView and WriteListLog() is in the unit FLogMsg, not in the same unit of the IdTCSPServer.

This is how is defined the tlistview in dfm

object ListLog: TListView
  Left = 0
  Top = 0
  Width = 737
  Height = 189
  Align = alClient
  Columns = <
    item
      Caption = 'Data'
      Width = 140
    end
    item
      Caption = 'Da'
    end
    item
      Caption = 'A'
    end
    item
      Caption = 'Tipo'
    end
    item
      Caption = 'Messaggio'
      Width = 900
    end>
  ColumnClick = False
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  FlatScrollBars = True
  OwnerData = True
  ReadOnly = True
  ParentFont = False
  TabOrder = 0
  ViewStyle = vsReport
  OnData = ListLogData
end

Code of unit FlogMsg:

type

  TTipoMessaggio = (tmSend,tmReceived,tmSystem);

  TDataItem = class
  private
    FDITimeStamp: TDateTime;
    FDIRecipient: String;
    FDISender: String;
    FDITipo: TTipoMessaggio;
    FDIMessaggio: String;

  public
    property DITimeStamp: TDateTime read FDITimeStamp;
    property DISender : String read FDISender;
    property DIRecipient : String read FDIRecipient;
    property DITipo : TTipoMessaggio read FDITipo;
    property DIMessaggio: String read FDIMessaggio;


  end;

  TfrmLog = class(TForm)
    ListLog: TListView;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure ListLogData(Sender: TObject; Item: TListItem);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FItems: TObjectList;
    FActiveItems: TList;
    FFilterLogStation: String;
    procedure SetFilterLogStation(const Value: String);
  public
    { Public declarations }
    property FilterLogStation : String read FFilterLogStation write SetFilterLogStation;
  end;

  procedure WriteListLog(aTimeStamp : TDateTime;
    aSender,aRecipient: String;aTipo:TTipoMessaggio;strMessaggio: String);

var
  frmLog: TfrmLog;


implementation

{$R *.dfm}

procedure WriteListLog(aTimeStamp : TDateTime;
  aSender,aRecipient: String;aTipo:TTipoMessaggio;strMessaggio: String);
var
  DataItem: TDataItem;
begin

  DataItem := TDataItem.Create;
  try
    DataItem.FDITimeStamp := aTimeStamp;
    DataItem.FDISender    := aSender;
    DataItem.FDIRecipient := aRecipient;
    DataItem.FDITipo      := aTipo;
    DataItem.FDIMessaggio := strMessaggio;

    frmLog.FItems.Add(DataItem);
    if (frmLog.FilterLogStation = '') or (frmLog.FilterLogStation = aRecipient) or
      (frmLog.FilterLogStation = aSender)  then
    begin
      frmLog.FActiveItems.Add(DataItem);
      frmLog.ListLog.AddItem('',DataItem);
    end;
  except
    DataItem.Free;
    raise;
  end;
  frmLog.ListLog.Repaint;
end;


procedure TfrmLog.FormCreate(Sender: TObject);
begin
  FFilterLogStation := '';
  FItems := TObjectList.Create;
  FActiveItems := TList.Create;
end;


procedure TfrmLog.FormDestroy(Sender: TObject);
begin
  FActiveItems.clear;
  FreeAndNil(FActiveItems);
  FreeAndNil(FItems);

end;

procedure TfrmLog.ListLogData(Sender: TObject; Item: TListItem);
var
  DataItem: TDataItem;
begin
  DataItem := FActiveItems[Item.Index];

  Item.Caption := FormatDateTime('dd/mm/yyy hh.nn.ss', DataItem.DITimeStamp);
  Item.SubItems.Add(DataItem.DISender);
  Item.SubItems.Add(DataItem.DIRecipient);
  // Tipo Messaggio
  case DataItem.DITipo of
    tmSend: Item.SubItems.Add('Inviato');
    tmReceived: Item.SubItems.Add('Ricevuto');
    tmSystem: Item.SubItems.Add('Sistema');
  end;

  Item.SubItems.Add(DataItem.DIMessaggio);
  Item.MakeVisible(true);

end;

procedure TfrmLog.SetFilterLogStation(const Value: String);
var
  I: Integer;
begin
  FFilterLogStation := Value;
  ListLog.Items.BeginUpdate;
  try
    ListLog.Clear;
    FActiveItems.Clear;
    for I := 0 to FItems.Count - 1 do
      if (CompareText(UpperCase(FFilterLogStation),UpperCase(TDataItem(FItems[I]).DISender)) = 0) or
        (CompareText(UpperCase(FFilterLogStation),UpperCase(TDataItem(FItems[I]).DIRecipient)) = 0)
        or (FFilterLogStation = '') then
      begin
        FActiveItems.Add(FItems[I]);
      end;
    ListLog.Items.Count := FActiveItems.Count;
  finally
    ListLog.Items.EndUpdate;
    ListLog.Repaint;
  end;
end;

procedure TfrmLog.FormDestroy(Sender: TObject);
begin
  FActiveItems.clear;
  FreeAndNil(FActiveItems);
  FreeAndNil(FItems);

end;

UPDATE 2 - Try with TMemo

this is the result:

I add a TStringList variable in my TMyContext class.
In debug session, for each Context, if I inspect the queue of message that is saved on my TStringList variable the messages are correct!
So, I think that the problem is in Synchronize...

    type  
      TTipoStazione = (tsNone,tsCarico,tsScarico);



      TLog = class(TIdSync)
        private
          FMsg : string;
          FFrom : String;
        protected
          procedure DoSynchronize; override;
        public

      end;


      TMyContext = class(TIdContext)

        public
          IP: String;
          UserName: String;
          Stazione : Integer;
          tipStaz : TTipoStazione; 
          Con: TDateTime;
          isValid : Boolean;
          ls : TStringList;
          // compname:string;
          procedure ProcessMsg;
      end;

      TForm1 = class(TForm)
        ts: TIdTCPServer;
        Memo1: TMemo;

        btconnect: TButton;
        edport: TEdit;
        Button2: TButton;
        procedure btconnectClick(Sender: TObject);
        procedure tsConnect(AContext: TIdContext);
        procedure tsExecute(AContext: TIdContext);
        procedure tsDisconnect(AContext: TIdContext);
        constructor Create(AOwner: TComponent);override;
        procedure FormDestroy(Sender: TObject);
        procedure Button2Click(Sender: TObject);
      private
        { Private declarations }
        procedure SendMsgBroadcast(aMsg : String); 
      public
        { Public declarations }
        procedure MyWriteListLog(strMessaggio : String);


      end;        




      implementation

        constructor TLog.Create(const aFrom: String; const AMsg: String);
        begin
          inherited Create;
          FMsg := AMsg;
          FFrom := aFrom;
        end;

        procedure TLog.DoSynchronize;
        begin
          Form1.MyWriteListLog(FMsg); 

        end;



        procedure TMyContext.ProcessMsg;
        var
          str,TypeMsg:string;
          myTLog: TLog;
        begin
          if Connection.IOHandler.InputBufferIsEmpty then
            exit;
          str:=self.Connection.IOHandler.ReadLn;
          ls.Add('1='+str);
          myTLog := Tlog.Create;
          try
            myTLog.FMsg := str;
            myTLog.FFrom := UserName;
            myTLog.Synchronize;
            ls.Add('2='+str);
          finally
            myTLog.Free;
          end;
        end;

        constructor TForm1.Create(AOwner: TComponent);
        begin
          inherited Create(AOwner);
          ts.ContextClass := TMyContext;
          DMVern := TDMVern.Create(nil);
        end;

        procedure TForm1.btconnectClick(Sender: TObject);
        begin
          ts.DefaultPort:=strtoint(edport.Text);
          ts.Active:=true;
          MyWriteListLog('Listening');
        end;    


        procedure TForm1.tsConnect(AContext: TIdContext);
        var
          strErr : String;
          I: Integer;
          tmpNrStaz: String;
          tmpMsg : String;

        begin
          strErr := '';
          ts.Contexts.LockList;
          try
            with TMyContext(AContext) do
            begin
              ls := TStringList.Create;
              isValid := false;

              Con := Now;
              if (Connection.Socket <> nil) then
                IP :=Connection.Socket.Binding.PeerIP;

              tmpMsg := Connection.IOHandler.ReadLn;


              try
                if not (Pos('START|',tmpMsg) > 0) then
                begin
                  strErr := 'Comando non valido';
                  exit;
                end;
                UserName := Copy(tmpMsg,Length('START|')+1,Length(tmpMsg));
                if Trim(UserName) = '' then
                begin
                  strErr := 'How Are You?';
                  exit;
                end;

                tipStaz := tsNone;
                if UpperCase(Copy(UserName,1,6)) = 'CARICO'  then
                  tipStaz := tsCarico
                else if UpperCase(Copy(UserName,1,7)) = 'SCARICO'  then
                  tipStaz := tsCarico;
                if tipStaz = tsNone then
                begin
                  strErr := 'Tipo Stazione non valida.';
                  exit;
                end;
                tmpNrStaz := '';
                for I := Length(UserName) downto 1 do
                begin
                  if (UserName[i] in ['0'..'9']) then
                    tmpNrStaz:= UserName[i] + tmpNrStaz
                  else if tmpNrStaz <> '' then
                    break;
                end;
                if tmpNrStaz = '' then
                begin
                  strErr := 'Numero Stazione non specificato.';
                  exit;
                end;
                Stazione := StrToInt(tmpNrStaz);
                isValid := true;
                tmpMsg := 'HELLO|' + UserName;
                Connection.IOHandler.WriteLn(tmpMsg);

              finally
                if strErr <> '' then
                begin
                  Connection.IOHandler.WriteLn(strErr);
                  Connection.Disconnect;
                end;
              end;
            end;
          finally
            ts.Contexts.UnlockList;
          end;
        end;    

        procedure TForm1.tsExecute(AContext: TIdContext);
        var
          Ctx: TMyContext;
          tmp : String;

        begin
          Ctx := TMyContext(AContext);
          Ctx.ProcessMsg;
        end;


        procedure TForm1.tsDisconnect(AContext: TIdContext);
        begin
          TMyContext(AContext).ProcessMsg;
        end;


        procedure TForm1.MyWriteListLog(strMessaggio: String);
        begin
          Memo1.Lines.Add(strMessaggio);
        end;

        procedure TForm1.Button2Click(Sender: TObject);
        var
          aMsg: String;
        begin
          aMsg := 'REQ|HeartBit';
          SendMsgBroadcast(aMsg);
        end;

        procedure TForm1.SendMsgBroadcast(aMsg: String);
        var
          List: TList;
          I: Integer;
          Context: TMyContext;
        begin
          List := ts.Contexts.LockList;
          try
            for I := 0 to List.Count-1 do
            begin
              Context := TMyContext(List[I]);
              if Context.isValid then
              begin
                try
                  Context.Connection.IOHandler.WriteLn(aMsg);
                except
                end;
              end;
            end;
          finally
            ts.Contexts.UnlockList;
          end;
        end;

You did not show what `WriteListLog()` does, or how you are managing the ListView messages. If Client2 sends only one answer, but you see it appear twice in the ListView, then you are not managing the ListView correctly. — Remy Lebeau, Nov 16 '14 at 20:58

Remy Lebeau · Accepted Answer · 2014-11-17T03:22:36.367

You are using a virtual ListView, but I see two mistakes you are making with it:

You are calling AddItem() and Clear() on it. Do not do that. The whole point of a virtual ListView is to not put any real data in it at all. After you add or remove objects in your FActiveItems list, all you have to do is update the TListView.Items.Count property to reflect the new item count. It will invalidate itself by default to trigger a repaint (but if you want to trigger a repaint manually, use Invalidate() instead of Repaint(), and call it only when you have done something to modify FActiveItems).
Your OnData handler is calling TListItem.MakeVisible(). That call does not belong in that event, it belongs in WriteListLog() instead. OnData triggered whenever the ListView needs data for an item for any reason, including during drawing. Don't perform any UI management operations in a data management event.

Try this instead:

procedure WriteListLog(aTimeStamp : TDateTime;
  aSender,aRecipient: String;aTipo:TTipoMessaggio;strMessaggio: String);
var
  DataItem: TDataItem;
  Index, ActiveIndex: Integer;
begin
  DataItem := TDataItem.Create;
  try
    DataItem.FDITimeStamp := aTimeStamp;
    DataItem.FDISender    := aSender;
    DataItem.FDIRecipient := aRecipient;
    DataItem.FDITipo      := aTipo;
    DataItem.FDIMessaggio := strMessaggio;

    Index := frmLog.FItems.Add(DataItem);
    try
      if (frmLog.FilterLogStation = '') or
        AnsiSameText(frmLog.FilterLogStation, aRecipient) or
        AnsiSameText(frmLog.FilterLogStation, aSender) then
      begin
        ActiveIndex := frmLog.FActiveItems.Add(DataItem);
        frmLog.ListLog.Items.Count := frmLog.FActiveItems.Count;
        frmLog.Items[ActiveIndex].MakeVisible(true);
      end;
    except
      frmLog.FItems.Delete(Index);
      DataItem := nil;
      raise;
    end;
  except
    DataItem.Free;
    raise;
  end;
end;

procedure TfrmLog.FormCreate(Sender: TObject);
begin
  FFilterLogStation := '';
  FItems := TObjectList.Create(True);
  FActiveItems := TList.Create;
end;

procedure TfrmLog.FormDestroy(Sender: TObject);
begin
  FItems.Free;
  FActiveItems.Free;
end;

procedure TfrmLog.ListLogData(Sender: TObject; Item: TListItem);
var
  DataItem: TDataItem;
begin
  DataItem := TDataItem(FActiveItems[Item.Index]);

  Item.Caption := FormatDateTime('dd/mm/yyy hh.nn.ss', DataItem.DITimeStamp);
  Item.SubItems.Add(DataItem.DISender);
  Item.SubItems.Add(DataItem.DIRecipient);
  // Tipo Messaggio
  case DataItem.DITipo of
    tmSend: Item.SubItems.Add('Inviato');
    tmReceived: Item.SubItems.Add('Ricevuto');
    tmSystem: Item.SubItems.Add('Sistema');
  else
    Item.SubItems.add('');
  end;
  Item.SubItems.Add(DataItem.DIMessaggio);
end;

procedure TfrmLog.SetFilterLogStation(const Value: String);
var
  I: Integer;
  DataItem: TDataItem;
begin
  if FFilterLogStation = Value then Exit;
  ListLog.Items.Count := 0;
  FActiveItems.Clear;
  FFilterLogStation := Value;
  try
    for I := 0 to FItems.Count - 1 do
    begin
      DataItem := TDataItem(FItems[I]);
      if (FFilterLogStation = '') or
        AnsiSameText(FFilterLogStation, DataItem.DISender) or
        AnsiSameText(FFilterLogStation), DataItem.DIRecipient) then
      begin
        FActiveItems.Add(DataItem);
      end;
    end;
  finally
    ListLog.Items.Count := FActiveItems.Count;
  end;
end;

The listView now is more reactive, Thanks. But the problem of synchronization has remained. Like I wrote, to prevent this problem, I call `FContextList.LockList` on execute of IdTCPServer before call my Syncronized Method, but I'm not sure that is the correct way. — user4258114, Nov 17 '14 at 07:51
There is nothing wrong with the sync code you have shown (and no, DO NOT call `LockList()`). You are using `TIdSync` correctly (I suspect your `sync.FMsg := tmp` statement is redundant as I would expect `Tlog.Create(tmp)` to assign `FMsg`). Again, if Client2 is sending 1 answer, but you are seeing 2 answers appear in the UI, then the problem is in your UI code, such as if you have 2 ListView items referring to the same TDataObject. One way to verify this is to drop a `TMemo` on your Form and have `WriteListLog()` add `strMessaggio` to that. You should not see any duplicate lines. — Remy Lebeau, Nov 17 '14 at 17:39
I Update my original Post (UPDATE 2 - Try with TMemo) but the problem persists — user4258114, Nov 20 '14 at 09:48
It is not a problem with `TIdSync`. A give call to `Synchronize()` can only run one time and then it is done. There is no possible way that receiving *one* copy of `ANS|CARICO1|I'm Alive` from a specific client produces *two* copies of `ANS|CARICO1|I'm Alive` in the Memo. Something else is going on. — Remy Lebeau, Nov 20 '14 at 19:42
And you need to get rid of `Contexts.LockList()` and `Context.UnlockList()` in `TForm1.tsConnect()`, they don't belong there. — Remy Lebeau, Nov 20 '14 at 19:45
I upgrade Indy to version 10.5.8.0. Now I don't see any problem of synchronization with GUI. Thanks a lot for your patient — user4258114, Nov 20 '14 at 22:26
@user4258114: Why did you upgrade to 10.5.8 and not to the latest 10.6.1? — Remy Lebeau, Nov 20 '14 at 22:40

Indy 10 Synchronize TIdTCPServer.onExecute with TIdSync

1 Answers1