怎么使TServerSocket在多线程下保持长连接

Question

我每次打开时客户端连接后,服务器端主动断开了,不知为什么
代码如下
    __Thread := TCommandThread.Create(ClientSocket, FTimeOut);
   SocketThread := __Thread;
    SocketThread.KeepInCache := false ;
    SocketThread.FreeOnTerminate := true ;
    SocketThread.Resume;
procedure TCommandThread.ClientExecute;
begin
  try
     ServerRecv:='进入ClientExecute';
    while (not Terminated) and ClientSocket.Connected do  begin
        ServerRecv:='已经连接';
        case WaitForData(FTimeOut) of   //时间
            wrSignaled: begin           //有数据进来,处理
                 ServerRecv:='数据进来,处理';
                 if ClientSocket.ReceiveLength>0 then 
                    ServerRecv:=ClientSocket.ReceiveText;
                   // break;
            end;
            wrTimeout: begin           //线程空闲超时
                ServerRecv :='线程空闲超时';
                break;
            end; 
            wrError:  begin            //由客户机关闭了连接
               ServerRecv:='客户机关闭了连接';
               break;
            end;
        end;
    end; //end while(not Terminated....)
  except
  end;end;

Answer 1

连接一段时间后,我在服务器端用netstat -na查看
客户端的端口在不断的变化,等一段时间后,他的状态就是FIN_WAIT_2了,不知到什么原因

Answer 2

你的类TCommandThread 是自己写的一个类吧,,如果是使用TServerSocket的stThreadBlocking模式的话,
可以考虑用从TServerClientThread继承一个类,然后使用TWinSocketStream 来跟客户端通讯.在在线帮助中,有很详细的例子,可参考一下

Answer 3

我试过用TWinSocketStream来跟客户端通讯,但还是不成,后来就修改成这样,我跟踪发现,创建的线程过段时间会自动销毁,不知是什么原因?

Answer 4

>>我试过用TWinSocketStream来跟客户端通讯,但还是不成TWinSocketStream有很多应用使用过,没有问题的.>>,创建的线程过段时间会自动销毁,不知是什么原因?原因可能是,
SocketThread.Resume;之后,线程的ClientExecute;运行完了,就退出而ClientExecute退出循环的可能是,出现了异常

Answer 5

比如,你把try放入while循环中,试试procedure TCommandThread.ClientExecute;
begin    ServerRecv:='进入ClientExecute';
    while (not Terminated) and ClientSocket.Connected do  
    begin
      try
        ServerRecv:='已经连接';
        case WaitForData(FTimeOut) of   //时间
            wrSignaled: begin           //有数据进来,处理
                 ServerRecv:='数据进来,处理';
                 if ClientSocket.ReceiveLength>0 then 
                    ServerRecv:=ClientSocket.ReceiveText;
                   // break;
            end;
            wrTimeout: begin           //线程空闲超时
                ServerRecv :='线程空闲超时';
                break;
            end; 
            wrError:  begin            //由客户机关闭了连接
               ServerRecv:='客户机关闭了连接';
               break;
            end;
        end;
      except
         //这样即使出现了异常,不会退出循环
      end;    end; //end while(not Terminated....)end;

Answer 6

这样还是不行，线程还是在不停的开启和关闭，导致CPU达100％

Answer 7

>>这样还是不行，线程还是在不停的开启和关闭，导致CPU达100％我的建议:
1.如果你 代码
    __Thread := TCommandThread.Create(ClientSocket, FTimeOut);
   SocketThread := __Thread;
    SocketThread.KeepInCache := false ;
    SocketThread.FreeOnTerminate := true ;
    SocketThread.Resume;
是在TServerSocket的OnGetThread中创建线程,然后出现线程还是在不停的开启和关闭，导致CPU达100％的这种情况,我建议楼主还是考虑用从TServerClientThread继承一个类,然后使用TWinSocketStream 来跟客户端通讯.这是delphi官方的推荐的方式,很多应用中都这样做,如果说楼主你不成功,把问题贴出来,让大家分析一下

Answer 8

这是主要的代码，请指点：谢谢！
TCommandThread = class(TServerClientThread)
  private
    FTimeOut: Integer;
    FStream: TWinSocketStream;
    lBuffer: TMemoryStream;
    lTmpBuffer: TMemoryStream;
  public
    procedure ClientExecute; override;
    constructor Create(ClientSocket: TServerClientWinSocket; TimeOut: Integer);
    destructor Destroy; override;
  end;constructor TCommandThread.Create(ClientSocket: TServerClientWinSocket; TimeOut: Integer);
begin
  inherited Create(true, ClientSocket);
  FTimeOut := TimeOut;
  FStream := TWinSocketStream.Create(ClientSocket, FTimeOut);
end;procedure TCommandThread.ClientExecute;
begin
  lBuffer := TMemoryStream.Create;
  lTmpBuffer := TMemoryStream.Create;
  ServerRecv:='进入ClientExecute';
  while (not Terminated) and ClientSocket.Connected do  begin
     try
          ServerRecv:='ClientSocket 已经连接';
          if not FStream.WaitForData(100) then begin
           break;
          end;
          if ClientSocket.ReceiveLength>0 then
           ServerRecv:=ClientSocket.ReceiveText;
      except      end;
  end; //end while(not Terminated....)
  if Assigned(lBuffer) then begin
     lBuffer.Free;
     lBuffer := nil;
  end;
  if Assigned(lTmpBuffer) then begin
     lTmpBuffer.Free;
     lTmpBuffer := nil;
  end;
end;
procedure TTibackSock.CommandGetThread(Sender: TObject; ClientSocket: TServerClientWinSocket;
  var SocketThread: TServerClientThread);
var MyThread: TCommandThread;
begin
  MyThread:= TCommandThread.Create(ClientSocket, FTimeOut);
    SocketThread := MyThread;
    SocketThread.KeepInCache := false ;
    SocketThread.FreeOnTerminate := true ;
    SocketThread.Resume;
end;

Answer 9

FServerSock := TServerSocket.Create(AOwner);
FServerSock.OnGetThread := CommandGetThread;
FServerSock.OnThreadEnd := CommandEndThread

Answer 10

肯定是执行了线程里的break语句，导致线程退出

Answer 11

问题出在这一段
if not FStream.WaitForData(100) then begin
break;
end
没收到数据就退出线程了，应该是收到则处理，没收到继续等待