我有同步服务器GUI的问题。我使用的是Delphi 2007和Indy 10.1.5。
这是我的情况：
服务器向所有连接的客户端发送一个听众（这是从服务器发送的消息 - ＆gt;＆＃34; REQ | HeartBit＆＃34;）
客户对服务器的响应＆＃34;我活着＆＃34; （这是从客户发送的消息 - ＆gt;＆＃34; ANS | USERNAME |我活着＆＃34;
在TIdTCPServer的onExecute过程中，我想在服务器的TlistView中看到客户端的答案，所以我在这个Link
当我连接两个进程客户端启动我的应用程序（在我的电脑上运行）并向客户端发送一个听觉消息时，我在服务器列表视图中看到这种情况：
REQ | HeartBit（发送给Client1）
REQ | HeartBit（发送给Client2）
ANS | Client2 |我活着
ANS | Client2 |我活着
来自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（发送给Client1）
REQ | HeartBit（发送给Client2）
ANS | Client1 |我活着
ANS | Client2 |我活着
它是正确的吗？
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
这是结果：
（First SendBroadCast HeartBit）
ANS | CARICO1 |我活着
ANS | CARICO2 |我活着
（Second SendBroadCast HeartBit）
ANS | CARICO1 |我活着
ANS | CARICO2 |我活着
（Third SendBroadCast HeartBit）
ANS | CARICO1 | I＆＃39; Alive
ANS | CARICO1 |我活着
我在TMyContext类中添加了一个TStringList变量
在调试会话中，对于每个Context，如果我检查保存在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;
答案 0 :(得分：0)
您正在使用虚拟ListView，但我发现您使用它犯了两个错误：
您正在呼叫AddItem()和Clear()。不要那样做。虚拟ListView的重点是不要在其中放入任何真实数据。在FActiveItems列表中添加或删除对象后，您只需更新TListView.Items.Count属性以反映新项目计数。默认情况下，它会使自身无效以触发重绘（但如果您想手动触发重新绘制，请使用Invalidate()而不是Repaint()，并且仅在您完成修改{{1}的操作时调用它}）。
您的FActiveItems处理程序正在调用OnData。该调用不属于该事件，而是属于TListItem.MakeVisible()。每当ListView因任何原因需要数据时触发WriteListLog()，包括在绘图期间。不要在数据管理事件中执行任何UI管理操作。
请改为尝试：
OnData