我做了个设备在线检测服务程序,创建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;
 

解决方案 »

  1.   

    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