Indy 10 将 TIdTCPServer.onExecute 与 TIdSync 同步答案

【问题标题】：Indy 10 Synchronize TIdTCPServer.onExecute with TIdSyncIndy 10 将 TIdTCPServer.onExecute 与 TIdSync 同步
【发布时间】：2014-11-20 17:46:46
【问题描述】：

我在同步服务器的 GUI 时遇到问题。我正在使用 Delphi 2007 和 Indy 10.1.5。

这是我的情况：
服务器向所有连接的客户端发送一个 heartbit（这是从服务器发送的消息 --> "REQ|HeartBit"）
客户端以“我还活着”响应服务器（这是从客户端发送的消息 --> “ANS|USERNAME|我还活着”
在 TIdTCPServer 的 onExecute 过程中，我想在服务器的 TlistView 中看到客户端的答案，所以我在 Link 中做了类似的事情

当我启动我的应用程序并连接两个进程客户端（在我的 PC 中运行）并向客户端发送 heartbit 消息时，我在服务器的列表视图中看到这种情况：

来自 Client2 的两条响应消息 (!?!?)
我的错在哪里？
对不起我的英语不好。
谢谢

服务器端的代码是这样的：

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;

正确吗？

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;

更新

在我的项目中，listView和WriteListLog()是在单位FLogMsg中，而不是在IdTCSPServer的同一个单位中。

这是在dfm中定义tlistview的方式

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

单元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;

更新 2 - 尝试使用 TMemo

这是结果：

我在我的 TMyContext 类中添加了一个 TStringList 变量。
在调试会话中，对于每个上下文，如果我检查保存在 TStringList 变量中的消息队列，则消息是正确的！
所以，我认为问题出在同步...

    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;

【问题讨论】：

您没有显示WriteListLog() 做了什么，或者您是如何管理 ListView 消息的。如果 Client2 只发送一个答案，但您看到它在 ListView 中出现两次，那么您没有正确管理 ListView。
@RemyLebeau 我更新了我的帖子。非常感谢。

标签： delphi sync indy

【解决方案1】：

您使用的是虚拟 ListView，但我发现您在使用它时犯了两个错误：

您正在调用 AddItem() 和 Clear()。不要那样做。虚拟 ListView 的全部意义在于根本不将任何真实数据放入其中。在FActiveItems 列表中添加或删除对象后，您所要做的就是更新TListView.Items.Count 属性以反映新的项目数。默认情况下它会失效以触发重绘（但如果您想手动触发重绘，请使用Invalidate() 而不是Repaint()，并且只有在您对FActiveItems 进行了修改时才调用它）。
您的 OnData 处理程序正在调用 TListItem.MakeVisible()。该呼叫不属于该事件，而是属于WriteListLog()。 OnData 每当 ListView 出于任何原因需要某个项目的数据时触发，包括在绘图期间。不要在数据管理事件中执行任何 UI 管理操作。

试试这个：

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;

【讨论】：

listView 现在更具反应性，谢谢。但是同步的问题仍然存在。就像我写的那样，为了防止这个问题，我在调用我的同步方法之前在 IdTCPServer 的执行上调用FContextList.LockList，但我不确定这是正确的方法。
您显示的同步代码没有任何问题（不，请勿致电LockList()）。您正在正确使用TIdSync（我怀疑您的sync.FMsg := tmp 语句是多余的，因为我希望Tlog.Create(tmp) 分配FMsg）。同样，如果 Client2 正在发送 1 个答案，但您看到 UI 中出现了 2 个答案，那么问题出在您的 UI 代码中，例如，如果您有 2 个 ListView 项引用同一个 TDataObject。验证这一点的一种方法是在您的表单上删除TMemo，并让WriteListLog() 添加strMessaggio。您应该不会看到任何重复的行。
我更新了我的原始帖子（更新 2 - 尝试使用 TMemo），但问题仍然存在
TIdSync 没有问题。对Synchronize() 的调用只能运行一次，然后就完成了。从特定客户端接收一个的ANS|CARICO1|I'm Alive 副本不可能在备忘录中生成两个的 ANS|CARICO1|I'm Alive 副本。其他事情正在发生。
而你需要去掉TForm1.tsConnect()中的Contexts.LockList()和Context.UnlockList()，它们不属于那里。