多线程通信主界面重复显示

[awi]

我做了个设备在线检测服务程序，创建10个线程，每个线程创建多次，从数据库取IP和端口。1号线程负责1、11、21......号设备信息,2号线程负责2、12、22..号设备信息。线程与主界面的ListBox通过同步回调函数进行数据往来。可是出现执行到最后一条线程时，不断重复相同内容。急求解答。
例如:与视频服务器 192.168.1.214 连接成功2009-04-18 19:00:00
与视频服务器 192.168.1.215 连接成功2009-04-18 19:00:05
与视频服务器 192.168.1.215 连接成功2009-04-18 19:00:05
unit 1;
MAX_THREAD_COUNT = 10; //最大线程连接数
procedure TForm1.ResponseProc(const AServerInfo: TServerInfo;
const AResponse: TResponse); //线程通信的回应信息
begin
if AResponse.ResponseType in [rtConnection, rtDataBase] then
LbLog.Items.Add(AResponse.Msg);//显示回答信息
end;
function TForm1.SaveToDB(const AServerInfo: TServerInfo;
const Msg: TStControlProxyNew): Boolean;//解释Msg，再把解析后的结果写入数据库
var
s: string;
begin
s := Format('来自于IP为[%s]视频服务器上的第[%d]个WSN设备离线',[AServerInfo.IP, Byte(Msg.ByData[0])])
LbLog.Items.Add(s);
Result := True;
end;
function TForm1.GetServerList(const Index: Integer): TServerList;
var
I: Integer;
begin
// 由线程ID返回线程需要查询的设备信息数组
Result := nil;
if Index > qry1.RecordCount then Exit;
for I := 1 to qry1.RecordCount do
begin
if (I - 1) mod Length(FThreadList) = Index then
begin
SetLength(Result, Length(Result) + 1);
qry1.RecNo := I;
Result[High(Result)].IP := qry1.FieldByName('EQ_IP').AsString;
Result[High(Result)].Port := StrToIntDef(qry1.FieldByName('EQ_Port2').AsString, 40005);
Result[High(Result)].ID := StrToIntDef(qry1.FieldByName('EQ_ID').AsString, 7);
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
ServerList: TServerList;
begin
FServerCount := 0;
OpenDB;
{$IFDEF SINGLE_SERVER}
SetLength(FThreadList, FServerCount);
{$ENDIF}
for i:=Low(FThreadList) to High(FThreadList) do
begin
ServerList := GetServerList(i);
if Length(ServerList) > 0 then
FThreadList[i] := TCommunicateThread.Create(ServerList, 1000, OnThreadTerminate,
ResponseProc, GetSendInfo, SaveToDB);
end;
end;

unit uCommunicateThread;
function TCommunicateThread.Connect(const AServerInfo: TServerInfo;
var AResponse: TResponse; ATimeOut: Integer): Boolean;
begin
Result := False;
AResponse.Msg := '未知错误';
AResponse.ResponseType := rtException;
if not Assigned(FIdTCPClient) then
begin
AResponse.Msg := '连接控件未初始化';
AResponse.ResponseType := rtException;
Exit;
end;
if FIdTCPClient.Connected then
try
FIdTCPClient.Disconnect;
except
on E: Exception do
begin
AResponse.Msg := '断开连接时发生异常：' + E.Message;
AResponse.ResponseType := rtException;
Exit;
end;
end;
try
FIdTCPClient.Host := AServerInfo.IP;
FIdTCPClient.Port := AServerInfo.Port;
FIdTCPClient.Connect(ATimeOut);
if FIdTCPClient.Connected then
begin
AResponse.Msg := Format('与视频服务器 %s 连接成功%s', [AServerInfo.IP, DateTimeToStr(Now)]);
AResponse.ResponseType := rtConnection;
Result := True;
end
else begin
AResponse.Msg := Format('无法与视频服务器 %s 连接', [AServerInfo.IP]);
AResponse.ResponseType := rtException;
end;
except
on E: Exception do
begin
AResponse.Msg := '通信发生异常：' + E.Message;
AResponse.ResponseType := rtException;
end;
end;
end;
function TCommunicateThread.LiveQuery(const AServerInfo: TServerInfo;
var AResponse: TResponse): Boolean;
var
QueryInfo: TStControlProxyNew;
begin
Result := False;
AResponse.Msg := '未知错误';
AResponse.ResponseType := rtException;
if not Assigned(FGetSendInfo) then
begin
AResponse.Msg := '未关联回调';
AResponse.ResponseType := rtException;
Exit;
end;
if not Assigned(FIdTCPClient) then
begin
AResponse.Msg := '连接控件未初始化';
AResponse.ResponseType := rtException;
Exit;
end;
if not FIdTCPClient.Connected then
begin
AResponse.Msg := '未连接';
AResponse.ResponseType := rtConnection;
Exit;
end;
QueryInfo := FGetSendInfo(AServerInfo, rtLiveQuery);
try
FIdTCPClient.WriteBuffer(QueryInfo, SizeOf(QueryInfo), True);
FIdTCPClient.ReadBuffer(FDBMsg, SizeOf(FDBMsg));
FDevSerialNo := AServerInfo.ID;
Synchronize(SyncSaveToDB);
if FDBSaved then
begin
AResponse.Msg := Format('保存IP为 %s 视频服务器上的设备状态成功', [AServerInfo.IP]);
AResponse.ResponseType := rtDataBase;
Result := True;
end
else begin
AResponse.Msg := Format('保存IP为 %s 视频服务器上的设备状态失败', [AServerInfo.IP]);
AResponse.ResponseType := rtDataBase;
end;
except
on E: Exception do
begin
AResponse.Msg := '通信发生异常：' + E.Message;
AResponse.ResponseType := rtException;
end;
end;
end;
constructor TCommunicateThread.Create(AServerList: TServerList;
const AInterval: Integer;
AOnTerminate: TNotifyEvent;
AResponseProc: TResponseProc;
AGetSendInfo: TGetSendInfo;
ASaveToDB: TSaveToDB);
var
I: Integer;
begin
FIdTCPClient := TIdTCPClient.Create(Application);
SetLength(FServerList, Length(AServerList));
for I := Low(AServerList) to High(AServerList) do
begin
FServerList[I].IP := AServerList[I].IP;
FServerList[I].Port := AServerList[I].Port;
FServerList[I].ID := AServerList[I].ID;
end;
FStop := False;
FInterval := AInterval;
OnTerminate := AOnTerminate;
FResponseProc := AResponseProc;
FGetSendInfo := AGetSendInfo;
FSaveToDB := ASaveToDB;
FreeOnTerminate := True;
FDBSaved := False;
FDevSerialNo := 0;
inherited Create(False);
end;
destructor TCommunicateThread.Destroy;
begin
if Assigned(FIdTCPClient) then
FIdTCPClient.Free;
inherited;
end;
procedure TCommunicateThread.Execute;
var
I: Integer;
AResponse: TResponse;
begin
while (not FStop) and (not Application.Terminated) do
begin
for I := Low(FServerList) to High(FServerList) do
begin
if Connect(FServerList[I], AResponse, 5000) then // 连接成功
begin
Response := AResponse;
LiveQuery(FServerList[I], AResponse);// 发送查询请求
Response := AResponse;
end
else begin // 连接失败
Response := AResponse;
end;
if FStop then // 用户要求停止
begin
Break;
end;
end;
Sleep(FInterval);
if FStop then Break;
end;
end;
procedure TCommunicateThread.SetResponse(const Value: TResponse);
begin
FResponse := Value;
Synchronize(SyncResponse);
end;
procedure TCommunicateThread.Stop;
var
ServerInfo: TServerInfo;
AResponse: TResponse;
begin
if Assigned(FIdTCPClient) and FIdTCPClient.Connected and Assigned(FGetSendInfo) then
begin
ServerInfo.IP := FIdTCPClient.Host;
ServerInfo.Port := FIdTCPClient.Port;
try
FIdTCPClient.Disconnect;
AResponse.Msg := Format('同主机 %s 的连接已断开！', [ServerInfo.IP]);
AResponse.ResponseType := rtConnection;
Response := AResponse;
FStop := True;
except
on E: Exception do
begin
AResponse.Msg := '断开连接时发生异常：' + E.Message;
AResponse.ResponseType := rtException;
Response := AResponse;
end;
end;
end;
end;
procedure TCommunicateThread.SyncResponse;
var
ServerInfo: TServerInfo;
begin
ServerInfo.IP := FIdTCPClient.Host;
ServerInfo.Port := FIdTCPClient.Port;
if Assigned(FResponseProc) then
FResponseProc(ServerInfo, FResponse);
end;
procedure TCommunicateThread.SyncSaveToDB;
var
ServerInfo: TServerInfo;
begin
FDBSaved := False;
ServerInfo.IP := FIdTCPClient.Host;
ServerInfo.Port := FIdTCPClient.Port;
ServerInfo.ID := FDevSerialNo;
if Assigned(FSaveToDB) then
begin
FDBSaved := FSaveToDB(ServerInfo, FDBMsg);
end;
end;

[yhf365]

....
看晕了~
帮顶

[starluck]

procedure TCommunicateThread.Execute; 
var 
  I: Integer; 
  AResponse: TResponse; 
begin 
  while (not FStop) and (not Terminated) do 
  begin 
    for I := Low(FServerList) to High(FServerList) do 
    begin 
      if Connect(FServerList[I], AResponse, 5000) then // 连接成功 
      begin 
        Response := AResponse; 
        LiveQuery(FServerList[I], AResponse);// 发送查询请求 
        Response := AResponse; 
      end 
      else begin // 连接失败 
        Response := AResponse; 
      end; 
      if FStop then // 用户要求停止 
      begin 
        Break; 
      end; 
    end; 
    Sleep(FInterval); 
    if FStop then Break; 
  end

[xingyongjian]

注意保护线程之间的共享数据;

[fenghuajuedai]

帮忙顶吧
我是看不懂的了