使用IndyTcp多线程通讯

Question

设置一个主端和若干个客户端 在主端上显示在线的客户端的个数
使用的IndyTcpServer和IdThreadMgrDefault
currentno表示个数
连接事件如下，不知道写的对不对，其实我是菜鸟，不怎么了解这个东西的运用。procedure TServerMain.serverConnect(AThread: TIdPeerThread);
var
  NewClientThread : Pointer;
begin
  athread.Data := TObject(NewClientThread);
  try
    Clients.LockList.Add(NewClientThread);  finally
    Clients.UnlockList;
  end;
   currentno := currentno + 1;
  edtno.Text := inttostr(currentno);
end;
断开事件如下
procedure TServerMain.serverDisconnect(AThread: TIdPeerThread);
var
  ActClientThread : Pointer;
begin
    ActClientThread := Pointer(athread.Data);
  try
    Clients.LockList.Remove(ActClientThread);  finally
    Clients.UnlockList;
  end;
  FreeMem(ActClientThread);
  AThread.Data := nil;
  currentno := currentno - 1;
  edtno.Text := inttostr(currentno);
end;客户端的界面打开就connect关闭就disconnect
先把服务端打开，客户端连接 显示正常。但是关闭窗口后却个数显示不正常，没有减1.
后来发现，没有执行服务端的serverdisconnect事件，所以个数一直没有减少，关闭服务端的时候提示异常
Terminate Thread Timeout
请问各位，这是为什么呢！

Answer 1

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
  AThread.Connection.WriteLn('连接成功!');
  Count := Count + 1;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  self.IdTCPServer1.Active := True;
  Count := 0;
end;
procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
begin
  Count := Count - 1;
  ShowMessage(IntToStr(Count));
end;
本地测试通过..没条件互联网测试！

Answer 2

服务端使用:IdTCPServer1
客户端使用:IdTCPClient1

Answer 3

看了下INDY的源代码, 直接取他的连接数就行,他里边用了个ThreadList 来保存连接的
下边我放在定时器里的代码procedure TForm1.Timer1Timer(Sender: TObject);
var
  Temp: TList;
begin
  Memo1.Lines.Add('当前连接数：' + IntToStr(TList(IdTCPServer1.Threads.lockList).Count));//IdTCPServer1.Threads.
  IdTCPServer1.Threads.UnlockList;  // 这步不能少, 要不别人都无法操作了
end;

Answer 4

在IndyTCPServe里的函数用的是
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);AThread.Connection.Server.Threads.LockList.Count // 这个就是当前连数
AThread.Connection.Server.Threads.unlock;Indy封装的比较令人头大

Answer 5

在外部定时器这么写就行了procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Memo1.Lines.Add('当前连接数：' + IntToStr(IdTCPServer1.Threads.lockList.Count));
  IdTCPServer1.Threads.UnlockList;  // 这步不能少, 要不别人都无法操作了
end;

Answer 6

用timer也尝试了一下 定时刷新 查询server.threads.locklist.count的数值
开启连接是正确的 但是断开连接还是不正确 server的disconnect事件执行有问题
这个也是参照Indy的demo来改的 不知道是哪里出了错误

Answer 7

你客户端连接后,有没DisConnect?
INDY 每个TCP都是单独一个线程,只要 Client 断开,服务端DISCONNECT肯定会有响应的

Answer 8

有 客户端这边都可以显示disconnect事件 但是服务端却不行

Answer 9

服务端
unit main;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, IdThreadMgr, IdThreadMgrDefault,
  IdBaseComponent, IdComponent, IdTCPServer, Unit1;type
   Voteinfo = record   // the Communication Block used in both parts (Server+Client)
    votesize: integer;
    isvote: boolean;  // HostIP of receiver
    end;
 //--------------------------------------------------------------------   
 PClient = ^TClient;
  TClient = record               // Object holding data of client (see events)
    HostIP : String[20];       { HostIP }
    Pointer_Thread : Pointer;            { Pointer to thread }
  end;
//--------------------------------------------------------------------
  TServerMain = class(TForm)
    Panel1: TPanel;
    Label3: TLabel;
    Panel7: TPanel;
    Label4: TLabel;
    Panel2: TPanel;
    Panel3: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Panel5: TPanel;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Button1: TButton;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    Panel4: TPanel;
    Panel6: TPanel;
    Label2: TLabel;
    server: TIdTCPServer;
    IdThreadMgrDefault1: TIdThreadMgrDefault;
    edtno: TEdit;
    Frame11: TFrame1;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure serverConnect(AThread: TIdPeerThread);
    procedure serverDisconnect(AThread: TIdPeerThread);
    procedure BitBtn4Click(Sender: TObject);
    procedure Frame11Button1Click(Sender: TObject);
    procedure serverExecute(AThread: TIdPeerThread);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  ServerMain: TServerMain;
  Clients         : TThreadList;     // Holds the data of all clients
  currentno       : integer;        //我自己加的 表示当前连接用户的个数
implementation{$R *.dfm}procedure TServerMain.FormCreate(Sender: TObject);
begin
     Clients := TThreadList.Create;
     server.Active := true;
     currentno := 0;
    edtno.Text := inttostr(currentno);
     MessageDlg('服务器启动！' + #13, mtInformation, [mbOk], 0);
     frame11.Visible := false;
end;procedure TServerMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    server.Active := false;
    clients.Free;
end;
//---------------------------------------------------------------
procedure TServerMain.serverConnect(AThread: TIdPeerThread);
var
  NewClient: PClient;
  NewClientThread : Pointer;
begin
  GetMem(NewClient, SizeOf(TClient));
  NewClient.HostIP := AThread.Connection.Socket.Binding.PeerIP;
  NewClient.Pointer_Thread := AThread;  AThread.Data:=TObject(NewClient);
  //newclientthread := athread;
  //athread.Data := TObject(NewClientThread);
  try
    Clients.LockList.Add(NewClient);
    
  finally
    Clients.UnlockList;
  end;
  //edtno.Text:= IntToStr(server.Threads.lockList.Count);
  //server.Threads.UnlockList;
  // currentno := currentno + 1;
  //edtno.Text := inttostr(currentno);
end;
//----------------------------------------------------------------
procedure TServerMain.serverDisconnect(AThread: TIdPeerThread);
var
  ActClient: PClient;
  //ActClientThread : Pointer;
begin
  ActClient := PClient(AThread.Data);
   // ActClientThread := Pointer(athread.Data);
  try
    Clients.LockList.Remove(ActClient);  finally
    Clients.UnlockList;
  end;
  FreeMem(ActClient);
  //FreeMem(ActClientThread);
  AThread.Data := nil;
  //currentno := currentno - 1;
  //edtno.Text := inttostr(currentno);
end;procedure TServerMain.BitBtn4Click(Sender: TObject);
begin
    frame11.Visible := true;
    frame11.Align := alclient;
end;
//----------------------------------------------------------------------
procedure TServerMain.Frame11Button1Click(Sender: TObject);
var
Newvoteinfo: voteinfo;
  i: Integer;
  RecThread: TIdPeerThread;
  RecClient: PClient;
begin
    newvoteinfo.votesize:=0;
    newvoteinfo.isvote:=true;    with Clients.LockList do
        try
          for i := 0 to Count-1 do  // iterate through client-list
        begin
            RecThread := Items[i];
            //RecClient := Items[i];           // get client-object
            //RecThread := RecClient.Pointer_Thread; // get client-thread out of it
            RecThread.Connection.WriteBuffer(Newvoteinfo, SizeOf(Newvoteinfo), True);  // send the stuff
          end;
        finally
          Clients.UnlockList;
        end;
end;procedure TServerMain.serverExecute(AThread: TIdPeerThread);
begin
  //-------------
end;procedure TServerMain.Timer1Timer(Sender: TObject);
begin
    edtno.Text := IntToStr(server.Threads.lockList.Count);
  server.Threads.UnlockList;  // 这步不能少, 要不别人都无法操作了
end;end.
客户端
unit main;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  StdCtrls, Buttons, ExtCtrls;type
   Voteinfo = record   // the Communication Block used in both parts (Server+Client)
    votesize: integer;
    isvote: boolean;  // HostIP of receiver
    end;
//-------------------------------------------
TClientHandleThread = class(TThread)
  private
 //   CB: TCommBlock;
     vi: voteinfo;  //record
    procedure HandleInput;
  protected
    procedure Execute; override;
  end;
  //----------------------------------------------------
  TClientMain = class(TForm)
    Panel1: TPanel;
    Label3: TLabel;
    Panel7: TPanel;
    Label4: TLabel;
    Edit1: TEdit;
    Panel2: TPanel;
    Panel3: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Panel5: TPanel;
    Label1: TLabel;
    ComboBox1: TComboBox;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    Panel4: TPanel;
    Panel6: TPanel;
    Label2: TLabel;
    client: TIdTCPClient;
    procedure FormCreate(Sender: TObject);
    procedure clientConnected(Sender: TObject);
    procedure clientDisconnected(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  ClientMain: TClientMain;
   ClientHandleThread: TClientHandleThread;
implementation{$R *.dfm}
 procedure TClientHandleThread.Execute;
begin
  while not Terminated do
  begin
    if not ClientMain.Client.Connected then
      Terminate
    else
    try
      ClientMain.Client.ReadBuffer(vi, SizeOf(vi));
      Synchronize(HandleInput);
    except
    end;
  end;
end;
//----------------------------------------------------
procedure TClientHandleThread.HandleInput;
begin
     if vi.isvote=true then
       clientmain.BitBtn4.Enabled :=true;
end;
//-----------------------------------------------------
procedure TClientMain.FormCreate(Sender: TObject);
begin
     try
      Client.Connect(10000);
      ClientHandleThread := TClientHandleThread.Create(True);
      ClientHandleThread.FreeOnTerminate := True;
      ClientHandleThread.Resume;    except
      on E: Exception do MessageDlg ('Error while connecting:' + #13 + E.Message,
                                      mtError, [mbOk], 0);
    end;end;
//--------------------------------------------------------
procedure TClientMain.clientConnected(Sender: TObject);
begin
   edit1.Text := '在线';
end;procedure TClientMain.clientDisconnected(Sender: TObject);
begin
    edit1.Text := '不在线';
end;procedure TClientMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   //ClientHandleThread.Terminate;
   client.Disconnect;
end;end.我也是参照几个demo和各位的指导来改的 不知道问题出在哪里

Answer 10

procedure TServerMain.Timer1Timer(Sender: TObject);
begin
  edtno.Text := IntToStr(server.Threads.lockList.Count);
  server.Threads.UnlockList; // 这步不能少, 要不别人都无法操作了
end;这个是我写的, 可能有问题
服务端关闭的时候,要写代码关闭所有连接,  如果这个定时器比较频繁的话, 估计关闭有问题, 主要是线程同步问题
还是改成在CONNECT  里加一, DISCONNECT里减一 比较好,定时器定时刷新数据 

Answer 11

另外在ONCONNECT ,DISCONNECT  最好不要直接操作VCL对象,它是放到另外的线程中处理, 
最好是用定时器刷新数据,发消息也可以 

Answer 12

感谢　三国迷
按照你说的在设置了一下，如果在那么Demo上面直接改就可以实现　但是我自己的上面那个server的disconnect事件就是不执行  在线数字只是可以增加不能减少。