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:
REQ|HeartBit (send to Client1)
REQ|HeartBit (send to Client2)
ANS|Client2|I'm Alive
ANS|Client2|I'm Alive
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;
If I add lockList in OnExecute I have this correct sequence of message
REQ|HeartBit (send to Client1)
REQ|HeartBit (send to Client2)
ANS|Client1|I'm Alive
ANS|Client2|I'm Alive
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:
(First SendBroadCast HeartBit)
ANS|CARICO1|I'm Alive
ANS|CARICO2|I'm Alive
(Second SendBroadCast HeartBit)
ANS|CARICO1|I'm Alive
ANS|CARICO2|I'm Alive
(Third SendBroadCast HeartBit)
ANS|CARICO1|I'm Alive
ANS|CARICO1|I'm Alive
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 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;