Indy 10将TIdTCPServer.onExecute与TIdSync同步

Question

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

这是我的情况：
服务器向所有连接的客户端发送一个Listenbit（这是从服务器发送的消息->“ REQ | HeartBit”）
客户端对服务器的响应为“我还活着”（这是从客户端发送的消息->“ ANS | USERNAME |我还活着”
在TIdTCPServer的onExecute过程中，我想在服务器的TlistView中查看客户端的答案，因此我已经在此链接中做了类似的操作

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

来自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;

Answer 1

您正在使用虚拟ListView，但是我看到您在使用它时犯了两个错误：

您正在调用AddItem()和Clear() 。 不要那样做。 虚拟ListView的全部目的是根本不将任何真实数据放入其中。 在FActiveItems列表中添加或删除对象之后，所有要做的就是更新TListView.Items.Count属性以反映新的项目计数。 默认情况下，它将使自身无效以触发重新绘制（但是，如果您要手动触发重新绘制，请使用Invalidate()而不是Repaint() ，并且仅在完成修改FActiveItems操作后调用它。
您的OnData处理程序正在调用TListItem.MakeVisible() 。 该调用不属于该事件，而是属于WriteListLog() 。 每当ListView由于某种原因（包括在绘图期间）需要某项数据时， OnData触发OnData 。 在数据管理事件中不要执行任何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;

Indy 10将TIdTCPServer.onExecute与TIdSync同步

问题描述

1 个解决方案

解决方案1
0 已采纳 2014-11-17 03:08:54

Indy 10将TIdTCPServer.onExecute与TIdSync同步

问题描述

1 个解决方案

解决方案1 0 已采纳 2014-11-17 03:08:54

解决方案1
0 已采纳 2014-11-17 03:08:54