Indy 10同步TIdTCPServer.onExecute與TIdSync

Question

我有一個同步服務器的GUI的問題。我使用的是Delphi 2007和Indy 10.1.5。

這是我的情況：
服務器發送給所有連接的客戶端hearbit（這是從郵件服務器發送 - >「REQ | HeartBit」）
與「我還活着」（客戶端響應服務器這是從客戶端發送的消息 - >「ANS | USERNAME |我還活着」
在TIdTCPServer的onExecute過程中，我想在服務器的TlistView中看到客戶端的答案，所以我在這裏完成了Link

當我開始我的應用程序與兩個進程客戶端連接（這是運行在我的電腦），併發送一個聽衆信息給客戶端，我在服務器列表中看到這種情況：

REQ | HeartBit（發送到客戶端1）
REQ | HeartBit（發送到客戶端2）
ANS |客戶端2 |我還活着
ANS |客戶端2 |我是活着

兩個響應消息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; 

如果我在OnExecute增加LOCKLIST我有消息
REQ的這個正確的順序| HeartBit（發送到客戶端1）
REQ | HeartBit （發送到客戶端2）
ANS |客戶端1 |我還活着
ANS |客戶端2 |我還活着

它是正確的？

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; 

UPDATE 2 - 與TMemo

嘗試這是結果：

（F IRST SendBroadCast HeartBit）
ANS | CARICO1 |我還活着
ANS | CARICO2 |我還活着
（二SendBroadCast HeartBit）
ANS | CARICO1 |我還活着
ANS | CARICO2 |我還活着
（第三SendBroadCast HeartBit）
ANS | CARICO1 |我還活着
ANS | CARICO1 |我還活着

我在我的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，但我看到了兩個錯誤，你用它做：

1. 要調用AddItem()和Clear()就可以了。不要那樣做。虛擬ListView的全部內容是根本不放入任何真實的數據。在FActiveItems列表中添加或刪除對象後，您只需更新TListView.Items.Count屬性即可反映新項目的數量。默認情況下，它會使自身失效以觸發重繪（但如果要手動觸發重繪，請使用Invalidate()而不是Repaint()，並且只有在完成某些操作後才能調用FActiveItems）。

2. 您的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;