[英]Indy 10 Synchronize TIdTCPServer.onExecute with TIdSync
I have a problem to sync the GUI of server. 我在同步服务器的GUI时遇到问题。 I'm using Delphi 2007 and Indy 10.1.5.
我正在使用Delphi 2007和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") 服务器向所有连接的客户端发送一个Listenbit(这是从服务器发送的消息->“ REQ | HeartBit”)
Client response to server with "I'm alive" (this is the message send from client --> "ANS|USERNAME|I'm alive" 客户端对服务器的响应为“我还活着”(这是从客户端发送的消息->“ ANS | USERNAME |我还活着”
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 在TIdTCPServer的onExecute过程中,我想在服务器的TlistView中查看客户端的答案,因此我已经在此链接中做了类似的操作
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: 当我在连接有两个进程客户端(在我的PC上运行)的情况下启动我的应用程序,并向客户端发送一个earbit消息时,我在服务器的列表视图中看到这种情况:
REQ|HeartBit (send to Client1) REQ | HeartBit(发送给Client1)
REQ|HeartBit (send to Client2) REQ | HeartBit(发送到Client2)
ANS|Client2|I'm Alive ANS | Client2 |我还活着
ANS|Client2|I'm Alive ANS | Client2 |我还活着
two response message from Client2 (!?!?) 来自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 如果我在OnExecute中添加lockList,则消息的顺序正确
REQ|HeartBit (send to Client1) REQ | HeartBit(发送给Client1)
REQ|HeartBit (send to Client2) REQ | HeartBit(发送到Client2)
ANS|Client1|I'm Alive ANS | Client1 |我还活着
ANS|Client2|I'm Alive ANS | Client2 |我还活着
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. 在我的项目中,listView和WriteListLog()位于FLogMsg单元中,而不位于IdTCSPServer的同一单元中。
This is how is defined the tlistview in dfm 这是在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
Code of unit FlogMsg: 单位代码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 更新2-尝试使用TMemo
this is the result: 结果是:
(First SendBroadCast HeartBit) (第一个SendBroadCast HeartBit)
ANS|CARICO1|I'm Alive ANS | CARICO1 |我还活着
ANS|CARICO2|I'm Alive ANS | CARICO2 |我还活着
(Second SendBroadCast HeartBit) (第二个SendBroadCast HeartBit)
ANS|CARICO1|I'm Alive ANS | CARICO1 |我还活着
ANS|CARICO2|I'm Alive ANS | CARICO2 |我还活着
(Third SendBroadCast HeartBit) (第三次SendBroadCast HeartBit)
ANS|CARICO1|I'm Alive ANS | CARICO1 |我还活着
ANS|CARICO1|I'm Alive ANS | CARICO1 |我还活着
I add a TStringList variable in my TMyContext class. 我在我的TMyContext类中添加了一个TStringList变量。
In debug session, for each Context, if I inspect the queue of message that is saved on my TStringList variable the messages are correct! 在调试会话中,对于每个上下文,如果我检查保存在TStringList变量中的消息队列,则消息是正确的!
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: 您正在使用虚拟ListView,但是我看到您在使用它时犯了两个错误:
You are calling AddItem()
and Clear()
on it. 您正在调用
AddItem()
和Clear()
。 Do not do that. 不要那样做。 The whole point of a virtual ListView is to not put any real data in it at all.
虚拟ListView的全部目的是根本不将任何真实数据放入其中。 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. 在
FActiveItems
列表中添加或删除对象之后,所有要做的就是更新TListView.Items.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
). 默认情况下,它将使自身无效以触发重新绘制(但是,如果您要手动触发重新绘制,请使用
Invalidate()
而不是Repaint()
,并且仅在完成修改FActiveItems
操作后调用它。
Your OnData
handler is calling TListItem.MakeVisible()
. 您的
OnData
处理程序正在调用TListItem.MakeVisible()
。 That call does not belong in that event, it belongs in WriteListLog()
instead. 该调用不属于该事件,而是属于
WriteListLog()
。 OnData
triggered whenever the ListView needs data for an item for any reason, including during drawing. 每当ListView由于某种原因(包括在绘图期间)需要某项数据时,
OnData
触发OnData
。 Don't perform any UI management operations in a data management event. 在数据管理事件中不要执行任何UI管理操作。
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;
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.