用Indy编写的客户/服务器程序,在客户端已连接的情况下,服务器IdTCPServer1->Active=false;会导致程序“未响应”

时间:2021-10-25 20:54:44
用Indy编写的客户/服务器程序,在客户端已连接的情况下,服务器IdTCPServer1->Active=false;会导致程序“未响应”,
在FormDestroy的时候IdTCPServer1->Active=false; 会导致程序无法正常结束(会一直留在任务管理器进程列表中),
这个是为什么,怎么样才能正常地执行IdTCPServer1->Active=false; 呢?
IDE是CB2010。

26 个解决方案

#1


不要直接IdTCPServer1->Active=false;TIdTCPSever内部维护一个连接list,如果存在连接然后Active=false,它会等待每一个连接断开,也就是如果没有主动断开,会一直到连接超时,也可能对方还在发送数据,那就一直不会断开。
大致上如此处理(未测试):
var
  AList: TIdContextList;
  i: integer;
begin
  if IdTCPServer1.Active then
  begin
    AList := IdTCPServer1.Contexts.LockList;
    try
      for i := 0 to AList.Count - 1 do
        TIdContext(AList[i]).Connection.Disconnect;
    finally
      IdTCPServer1.Contexts.UnlockList;
    end;
  end;
end;

#2


@早打大打打核战争
好,我有空试下。

IdTCPServer1->Bindings->Add()->IP="127.0.0.1";
IdTCPServer1->Bindings->Add()->Port=edtPort->Text.ToInt();
以后,如何取消绑定呢?

#3


这样写有问题,每次Add都产生一个新的TIdSocketHandle。
应该:
TIdSocketHandle *IdSocketHandle = IdTCPServer1->Bindings->Add();
IdSocketHandle->IP=...
IdSocketHandle->Port=...
IdSocketHandle->Bind();

取消绑定:
 IdTCPServer1->Bindings[i]->CloseSocket();
CloseSocket内部调用了Disconnect。

#4


@早打大打打核战争
好。我用CB2010,发现没有TIdContextList,但有TIdThreadList,但是头文件IdObjs.hpp找不到,在安装目录搜索IdObjs也没有一个文件,是不是Delphi没装Indy文件不全?

#5


@早打大打打核战争
      for i := 0 to AList.Count - 1 do
        TIdContext(AList[i]).Connection.Disconnect;
如果Count有两个,第0个Context连接断了,第1个Context会不会自动变为第0个?

#6


那你用的可能是indy9,indy10变化很大,你看看有没有source\Indy10\Core\IdContext.pas

#7


@早打大打打核战争
CB2010是Indy 10.5.5,但是文档版本是10.1.1。不知道最高版本是多少?
IdContext.pas、dcu和hpp都有。

#8


引用 5 楼 u010165006 的回复:
@早打大打打核战争
      for i := 0 to AList.Count - 1 do
        TIdContext(AList[i]).Connection.Disconnect;
如果Count有两个,第0个Context连接断了,第1个Context会不会自动变为第0个?


不会,这里AList := IdTCPServer1.Contexts.LockList;是获取的一个快照

#9


@早打大打打核战
嗯,你的机子上Indy有TIdContextList吗?

#10


有啊。
IdContext.pas
...
type
  TIdContext = class;
  TIdContextClass = class of TIdContext;
  TIdContextRun = function(AContext: TIdContext): Boolean of object;
  TIdContextEvent = procedure(AContext: TIdContext) of object;
  TIdContextExceptionEvent = procedure(AContext: TIdContext; AException: Exception) of object;

  {$IFDEF HAS_GENERICS_TThreadList}
  TIdContextThreadList = TIdThreadSafeObjectList<TIdContext>;
  TIdContextList = TList<TIdContext>;
  {$ELSE}
                                                                                                      
  TIdContextThreadList = TIdThreadSafeObjectList;
  TIdContextList = TList;
  {$ENDIF}

#11


RAD Studio 10.2里带的indy版本是10.6.2.5366

#12


你现在用10.2了?CB2010里的还是老版本,看来我也要与时俱进了。

{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
  Rev 1.14    6/16/2004 2:08:48 PM  JPMugaas
  Binding made public for the FTP Server.

  Rev 1.13    6/4/2004 1:34:24 PM  DSiders
  Removed unused TIdContextDoRun, TIdContextMethod types.

  Rev 1.12    2004.02.03 4:17:08 PM  czhower
  For unit name changes.

  Rev 1.11    21.1.2004 ? 12:31:04  DBondzhev
  Fix for Indy source. Workaround for dccil bug
  now it can be compiled using Compile instead of build

  Rev 1.10    2003.10.21 12:18:58 AM  czhower
  TIdTask support and fiber bug fixes.

  Rev 1.9    2003.10.11 5:47:18 PM  czhower
  -VCL fixes for servers
  -Chain suport for servers (Super core)
  -Scheduler upgrades
  -Full yarn support

  Rev 1.8    2003.09.19 11:54:28 AM  czhower
  -Completed more features necessary for servers
  -Fixed some bugs

  Rev 1.7    3/22/2003 09:45:26 PM  JPMugaas
  Now should compile under D4.

  Rev 1.6    3/13/2003 10:18:38 AM  BGooijen
  Server side fibers, bug fixes

  Rev 1.5    1/31/2003 7:24:18 PM  BGooijen
  Added a .Binding function

  Rev 1.4    1/23/2003 8:33:20 PM  BGooijen

  Rev 1.3    1/23/2003 11:06:06 AM  BGooijen


  Rev 1.2    1-17-2003 23:58:30  BGooijen
  removed OnCreate/OnDestroy again, they had no use

  Rev 1.0    1-17-2003 22:28:58  BGooijen
}

unit IdContext;

interface

{$i IdCompilerDefines.inc}

uses
  Classes,
  IdSocketHandle, IdTCPConnection, IdTask, IdYarn, SysUtils;

type
  TIdContext = class;
  TIdContextClass = class of TIdContext;
  TIdContextRun = function(AContext: TIdContext): Boolean of object;
  TIdContextEvent = procedure(AContext: TIdContext) of object;
  TIdContextExceptionEvent = procedure(AContext: TIdContext; AException: Exception) of object;

  TIdContext = class(TIdTask)
  protected
    // A list in which this context is registered, this can be nil, and should
    // therefore not be used
    FContextList: TThreadList;
    FConnection: TIdTCPConnection;
    FOwnsConnection: Boolean;
    FOnRun: TIdContextRun;
    FOnBeforeRun: TIdContextEvent;
    FOnAfterRun: TIdContextEvent;
    FOnException: TIdContextExceptionEvent;
    //
    procedure BeforeRun; override;
    function Run: Boolean; override;
    procedure AfterRun; override;
    procedure HandleException(AException: Exception); override;
  public
    constructor Create(
      AConnection: TIdTCPConnection;
      AYarn: TIdYarn;
      AList: TThreadList = nil
      ); reintroduce; virtual;
    destructor Destroy; override;
    procedure RemoveFromList;
    function Binding: TIdSocketHandle;
    //
    property Connection: TIdTCPConnection read FConnection;
    //
    property OnAfterRun: TIdContextEvent read FOnAfterRun write FOnAfterRun;
    property OnBeforeRun: TIdContextEvent read FOnBeforeRun write FOnBeforeRun;
    property OnRun: TIdContextRun read FOnRun write FOnRun;
    property OnException: TIdContextExceptionEvent read FOnException write FOnException;
  end;

implementation

{ TIdContext }

uses
  IdGlobal,
  IdIOHandlerSocket;

constructor TIdContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
  inherited Create(AYarn);
  FConnection := AConnection;
  FOwnsConnection := True;
  FContextList := AList;
end;

destructor TIdContext.Destroy;
begin
  if Assigned(FContextList) then begin
    FContextList.Remove(Self);
  end;

  if FOwnsConnection then begin
    FreeAndNil(FConnection);
  end;

  inherited Destroy;
end;

procedure TIdContext.RemoveFromList;
begin
  FContextList := nil;
end;

procedure TIdContext.BeforeRun;
begin
  //Context must be added to ContextList outside of create. This avoids
  //the possibility of another thread accessing a context (specifically
  //a subclass) that is still creating. similar logic for remove/destroy.
  if Assigned(FContextList) then begin
    FContextList.Add(Self);
  end;

  if Assigned(OnBeforeRun) then begin
    OnBeforeRun(Self);
  end;
end;

function TIdContext.Run: Boolean;
begin
  if Assigned(OnRun) then begin
    Result := OnRun(Self);
  end else begin
    Result := True;
  end;
end;

procedure TIdContext.AfterRun;
begin
  if Assigned(OnAfterRun) then begin
    OnAfterRun(Self);
  end;

  if FContextList <> nil then begin
    FContextList.Remove(Self);
  end;
end;

procedure TIdContext.HandleException(AException: Exception);
begin
  if Assigned(OnException) then begin
    OnException(Self, AException);
  end;
end;

function TIdContext.Binding: TIdSocketHandle;
begin
  Result := nil;
  if Connection <> nil then begin
    if Connection.Socket <> nil then begin
      Result := Connection.Socket.Binding;
    end;
  end;
end;

end.

#13


你现在用10.2了?CB2010里的还是老版本,看来我也要与时俱进了。

{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
  Rev 1.14    6/16/2004 2:08:48 PM  JPMugaas
  Binding made public for the FTP Server.

  Rev 1.13    6/4/2004 1:34:24 PM  DSiders
  Removed unused TIdContextDoRun, TIdContextMethod types.

  Rev 1.12    2004.02.03 4:17:08 PM  czhower
  For unit name changes.

  Rev 1.11    21.1.2004 ? 12:31:04  DBondzhev
  Fix for Indy source. Workaround for dccil bug
  now it can be compiled using Compile instead of build

  Rev 1.10    2003.10.21 12:18:58 AM  czhower
  TIdTask support and fiber bug fixes.

  Rev 1.9    2003.10.11 5:47:18 PM  czhower
  -VCL fixes for servers
  -Chain suport for servers (Super core)
  -Scheduler upgrades
  -Full yarn support

  Rev 1.8    2003.09.19 11:54:28 AM  czhower
  -Completed more features necessary for servers
  -Fixed some bugs

  Rev 1.7    3/22/2003 09:45:26 PM  JPMugaas
  Now should compile under D4.

  Rev 1.6    3/13/2003 10:18:38 AM  BGooijen
  Server side fibers, bug fixes

  Rev 1.5    1/31/2003 7:24:18 PM  BGooijen
  Added a .Binding function

  Rev 1.4    1/23/2003 8:33:20 PM  BGooijen

  Rev 1.3    1/23/2003 11:06:06 AM  BGooijen


  Rev 1.2    1-17-2003 23:58:30  BGooijen
  removed OnCreate/OnDestroy again, they had no use

  Rev 1.0    1-17-2003 22:28:58  BGooijen
}

unit IdContext;

interface

{$i IdCompilerDefines.inc}

uses
  Classes,
  IdSocketHandle, IdTCPConnection, IdTask, IdYarn, SysUtils;

type
  TIdContext = class;
  TIdContextClass = class of TIdContext;
  TIdContextRun = function(AContext: TIdContext): Boolean of object;
  TIdContextEvent = procedure(AContext: TIdContext) of object;
  TIdContextExceptionEvent = procedure(AContext: TIdContext; AException: Exception) of object;

  TIdContext = class(TIdTask)
  protected
    // A list in which this context is registered, this can be nil, and should
    // therefore not be used
    FContextList: TThreadList;
    FConnection: TIdTCPConnection;
    FOwnsConnection: Boolean;
    FOnRun: TIdContextRun;
    FOnBeforeRun: TIdContextEvent;
    FOnAfterRun: TIdContextEvent;
    FOnException: TIdContextExceptionEvent;
    //
    procedure BeforeRun; override;
    function Run: Boolean; override;
    procedure AfterRun; override;
    procedure HandleException(AException: Exception); override;
  public
    constructor Create(
      AConnection: TIdTCPConnection;
      AYarn: TIdYarn;
      AList: TThreadList = nil
      ); reintroduce; virtual;
    destructor Destroy; override;
    procedure RemoveFromList;
    function Binding: TIdSocketHandle;
    //
    property Connection: TIdTCPConnection read FConnection;
    //
    property OnAfterRun: TIdContextEvent read FOnAfterRun write FOnAfterRun;
    property OnBeforeRun: TIdContextEvent read FOnBeforeRun write FOnBeforeRun;
    property OnRun: TIdContextRun read FOnRun write FOnRun;
    property OnException: TIdContextExceptionEvent read FOnException write FOnException;
  end;

implementation

{ TIdContext }

uses
  IdGlobal,
  IdIOHandlerSocket;

constructor TIdContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
  inherited Create(AYarn);
  FConnection := AConnection;
  FOwnsConnection := True;
  FContextList := AList;
end;

destructor TIdContext.Destroy;
begin
  if Assigned(FContextList) then begin
    FContextList.Remove(Self);
  end;

  if FOwnsConnection then begin
    FreeAndNil(FConnection);
  end;

  inherited Destroy;
end;

procedure TIdContext.RemoveFromList;
begin
  FContextList := nil;
end;

procedure TIdContext.BeforeRun;
begin
  //Context must be added to ContextList outside of create. This avoids
  //the possibility of another thread accessing a context (specifically
  //a subclass) that is still creating. similar logic for remove/destroy.
  if Assigned(FContextList) then begin
    FContextList.Add(Self);
  end;

  if Assigned(OnBeforeRun) then begin
    OnBeforeRun(Self);
  end;
end;

function TIdContext.Run: Boolean;
begin
  if Assigned(OnRun) then begin
    Result := OnRun(Self);
  end else begin
    Result := True;
  end;
end;

procedure TIdContext.AfterRun;
begin
  if Assigned(OnAfterRun) then begin
    OnAfterRun(Self);
  end;

  if FContextList <> nil then begin
    FContextList.Remove(Self);
  end;
end;

procedure TIdContext.HandleException(AException: Exception);
begin
  if Assigned(OnException) then begin
    OnException(Self, AException);
  end;
end;

function TIdContext.Binding: TIdSocketHandle;
begin
  Result := nil;
  if Connection <> nil then begin
    if Connection.Socket <> nil then begin
      Result := Connection.Socket.Binding;
    end;
  end;
end;

end.

#14


你现在用10.2了?CB2010里的还是老版本,看来我也要与时俱进了。

{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
  Rev 1.14    6/16/2004 2:08:48 PM  JPMugaas
  Binding made public for the FTP Server.

  Rev 1.13    6/4/2004 1:34:24 PM  DSiders
  Removed unused TIdContextDoRun, TIdContextMethod types.

  Rev 1.12    2004.02.03 4:17:08 PM  czhower
  For unit name changes.

  Rev 1.11    21.1.2004 ? 12:31:04  DBondzhev
  Fix for Indy source. Workaround for dccil bug
  now it can be compiled using Compile instead of build

  Rev 1.10    2003.10.21 12:18:58 AM  czhower
  TIdTask support and fiber bug fixes.

  Rev 1.9    2003.10.11 5:47:18 PM  czhower
  -VCL fixes for servers
  -Chain suport for servers (Super core)
  -Scheduler upgrades
  -Full yarn support

  Rev 1.8    2003.09.19 11:54:28 AM  czhower
  -Completed more features necessary for servers
  -Fixed some bugs

  Rev 1.7    3/22/2003 09:45:26 PM  JPMugaas
  Now should compile under D4.

  Rev 1.6    3/13/2003 10:18:38 AM  BGooijen
  Server side fibers, bug fixes

  Rev 1.5    1/31/2003 7:24:18 PM  BGooijen
  Added a .Binding function

  Rev 1.4    1/23/2003 8:33:20 PM  BGooijen

  Rev 1.3    1/23/2003 11:06:06 AM  BGooijen


  Rev 1.2    1-17-2003 23:58:30  BGooijen
  removed OnCreate/OnDestroy again, they had no use

  Rev 1.0    1-17-2003 22:28:58  BGooijen
}

unit IdContext;

interface

{$i IdCompilerDefines.inc}

uses
  Classes,
  IdSocketHandle, IdTCPConnection, IdTask, IdYarn, SysUtils;

type
  TIdContext = class;
  TIdContextClass = class of TIdContext;
  TIdContextRun = function(AContext: TIdContext): Boolean of object;
  TIdContextEvent = procedure(AContext: TIdContext) of object;
  TIdContextExceptionEvent = procedure(AContext: TIdContext; AException: Exception) of object;

  TIdContext = class(TIdTask)
  protected
    // A list in which this context is registered, this can be nil, and should
    // therefore not be used
    FContextList: TThreadList;
    FConnection: TIdTCPConnection;
    FOwnsConnection: Boolean;
    FOnRun: TIdContextRun;
    FOnBeforeRun: TIdContextEvent;
    FOnAfterRun: TIdContextEvent;
    FOnException: TIdContextExceptionEvent;
    //
    procedure BeforeRun; override;
    function Run: Boolean; override;
    procedure AfterRun; override;
    procedure HandleException(AException: Exception); override;
  public
    constructor Create(
      AConnection: TIdTCPConnection;
      AYarn: TIdYarn;
      AList: TThreadList = nil
      ); reintroduce; virtual;
    destructor Destroy; override;
    procedure RemoveFromList;
    function Binding: TIdSocketHandle;
    //
    property Connection: TIdTCPConnection read FConnection;
    //
    property OnAfterRun: TIdContextEvent read FOnAfterRun write FOnAfterRun;
    property OnBeforeRun: TIdContextEvent read FOnBeforeRun write FOnBeforeRun;
    property OnRun: TIdContextRun read FOnRun write FOnRun;
    property OnException: TIdContextExceptionEvent read FOnException write FOnException;
  end;

implementation

{ TIdContext }

uses
  IdGlobal,
  IdIOHandlerSocket;

constructor TIdContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
  inherited Create(AYarn);
  FConnection := AConnection;
  FOwnsConnection := True;
  FContextList := AList;
end;

destructor TIdContext.Destroy;
begin
  if Assigned(FContextList) then begin
    FContextList.Remove(Self);
  end;

  if FOwnsConnection then begin
    FreeAndNil(FConnection);
  end;

  inherited Destroy;
end;

procedure TIdContext.RemoveFromList;
begin
  FContextList := nil;
end;

procedure TIdContext.BeforeRun;
begin
  //Context must be added to ContextList outside of create. This avoids
  //the possibility of another thread accessing a context (specifically
  //a subclass) that is still creating. similar logic for remove/destroy.
  if Assigned(FContextList) then begin
    FContextList.Add(Self);
  end;

  if Assigned(OnBeforeRun) then begin
    OnBeforeRun(Self);
  end;
end;

function TIdContext.Run: Boolean;
begin
  if Assigned(OnRun) then begin
    Result := OnRun(Self);
  end else begin
    Result := True;
  end;
end;

procedure TIdContext.AfterRun;
begin
  if Assigned(OnAfterRun) then begin
    OnAfterRun(Self);
  end;

  if FContextList <> nil then begin
    FContextList.Remove(Self);
  end;
end;

procedure TIdContext.HandleException(AException: Exception);
begin
  if Assigned(OnException) then begin
    OnException(Self, AException);
  end;
end;

function TIdContext.Binding: TIdSocketHandle;
begin
  Result := nil;
  if Connection <> nil then begin
    if Connection.Socket <> nil then begin
      Result := Connection.Socket.Binding;
    end;
  end;
end;

end.

#15


用Indy编写的客户/服务器程序,在客户端已连接的情况下,服务器IdTCPServer1->Active=false;会导致程序“未响应”

#16


一直回复失败,居然连发3贴,再次提交才提示已连续回复3次无法回帖。 用Indy编写的客户/服务器程序,在客户端已连接的情况下,服务器IdTCPServer1->Active=false;会导致程序“未响应”

#17


我也装上10.2了,Indy的手册Indy10.chm居然还是10.1.5的,有些有点对不上,比如
TIdIOHandler.WriteLn Method
Pascal
procedure WriteLn(
    const AOut: string = ''
); virtual;
没有字符串编码参数的重载版本,虽然这个问题已经解决了:IdTCPClient1.IOHandler.WriteLn(sendData,IndyTextEncoding(TEncoding.ANSI));  

Indy为什么不搞个最新版的手册呢?
Indy10.chm手册字体也太小了,用了个FreeChmZoomer工具才解决,麻烦了点。

#18


@早打大打打核战争
这个代码有没有问题:
//---------------------------------------------------------------------------
void __fastcall TForm1::CheckBox1Click(TObject *Sender)
{
TIdSocketHandle *IdSocketHandle;
if(CheckBox1->Checked)
{
IdSocketHandle=IdTCPServer1->Bindings->Add();
IdSocketHandle->IP="127.0.0.1";
IdSocketHandle->Port=Edit1->Text.ToInt();
     //   IdSocketHandle->Bind();
IdTCPServer1->Active=true;
}
else
{
TIdContextList *AList;
AList=IdTCPServer1->Contexts->LockList();
for(int i=0;i<AList->Count;i++)
{
TIdContext *AContext=(TIdContext *)AList->Items[i];
AContext->Connection->Disconnect();
}
IdTCPServer1->Contexts->UnlockList();

// IdSocketHandle->CloseSocket();
IdTCPServer1->Bindings->Clear();
IdTCPServer1->Active=false;
}
}
//---------------------------------------------------------------------------


IdSocketHandle->CloseSocket(); 会导致access violation错误?
这个代码,我server程序反复地选中、取消选中CheckBox1,client端对应地连接、断开连接,反复几次以后,在客户端连接的情况下,取消选中CheckBox1,会使server程序未响应,有时候连续反复3次就出现,有时候反复5、6次才出现,这个是不是代码的问题呢?

#19


你这里else部分的IdSocketHandle没有初始化,IdSocketHandle=IdTCPServer1->Bindings->Add();在if部分。另外,我前面说的不要直接IdTCPServer1->Active=false;是错的,我看了一下indy10的源码,在TCustomIdTCPServer的SetActive方法中,如果Active=false,它的处理是停止监听(StopListening),终止全部worker线程(TerminateAllThreads),然后对每个context的连接做Disconnect(DoTerminateContext),所以这样应该是可以很快停掉Server(不过我测试比手工直接逐一Disconnect要慢一点)。之所以某些时候出现程序未响应的情况是因为Disconnect事件处理是在Server的内部线程中执行的,IdTCPServer1->Active=false;的时候会调用Disconnect事件处理,在其中直接操作GUI是非线程安全的(其实Connect、Execute等等事件处理都有这个问题,只是很少碰到),要用Synchronize方法,indy已经封装了一个TIdNotify类,TIdNotify.NotifyMethod(xxx);在xxx中操作GUI。

#20


@早打大打打核战争
我这样改了一下,貌似可以了:
//---------------------------------------------------------------------------
void __fastcall TForm1::CheckBox1Click(TObject *Sender)
{
if(CheckBox1->Checked)
{
IdSocketHandle=IdTCPServer1->Bindings->Add();
IdSocketHandle->IP="127.0.0.1";
IdSocketHandle->Port=Edit1->Text.ToInt();
     //   IdSocketHandle->Bind();
IdTCPServer1->Active=true;
}
else
{
IdSocketHandle->CloseSocket();
IdTCPServer1->Bindings->Clear();
IdTCPServer1->Active=false;
}
}
//---------------------------------------------------------------------------
void __fastcall TForm1::IdTCPServer1Disconnect(TIdContext *AContext)
{
TIdNotify::NotifyMethod(ShowDisconnectMessage);
aClientConnected=false;
}
//---------------------------------------------------------------------------
void __fastcall TForm1::ShowDisconnectMessage()
{
UnicodeString s="一个客户端断开连接";
Memo1->Lines->Add(s);
}
//---------------------------------------------------------------------------

IdSocketHandle->Bind(); 似乎没必要?
TIdSocketHandle *IdSocketHandle;没注意是局部变量,改成类成员变量可以了。
操作GUI非线程安全,我的理解是GUI可能被不同线程改写导致非预期结果,为什么会导致程序未响应呢?

#21


直接调用Bind()确实没有必要。之所以导致程序未响应,因为你在主线程的事件处理中调用:
void __fastcall TForm1::CheckBox1Click(TObject *Sender)
{
//...
        IdTCPServer1->Active=false;
// ...
}
 IdTCPServer1->Active=false;实际是 IdTCPServer1->SetActive(false);方法,该方法中停止监听、终止worker线程、断开连接,断开连接中会调用Disconnect事件处理,如果在Disconnect事件处理操作GUI,比如Memo1->Lines->Add(s);,这依赖主线程中的消息循环,比如WM_SETTEXT,如果消息没有处理则Add不会完成,Disconnect事件处理不会结束,worker线程不会终止,IdTCPServer1->SetActive(false);不会返回,TForm1::CheckBox1Click不会返回,而TForm1::CheckBox1Click不返回则主线程的消息循环不会继续,消息队列中的消息得不到处理,Memo1->Lines->Add(s);无法完成,于是就陷入死锁状态了。
所以,只要在Disconnect事件处理中不进行任何依赖主线程消息处理的操作就不会有问题,比如写文件,或者AllocConsole(); printf(...);之类都没有问题。

#22


@早打大打打核战争
是不是TForm1::CheckBox1Click不返回,WM_SETTEXT消息也在队列里得不到处理,从而死锁呢?
Connect、Execute事件有这个问题为什么很少碰到呢?

#23


1. CheckBox1Click也是有消息触发的,是在消息循环中被调用的,所以它卡住了,后面的消息就得不到处理。
2. 很少碰到是说在这些事件处理中直接操作GUI是非线程安全的,不是死锁,就我看到的TIdTCPServer的代码,只有在Disconnect中直接操作GUI可能导致死锁,其他事件处理都不会,除了SetActive(false),没有其他方法等待worker线程完成再返回。

#24


@早打大打打核战争
其它事件处理中直接操作GUI是非线程安全的,不是死锁那还好,如果代码都要TIdNotify::NotifyMethod也挺繁复的。

#25


引用 8 楼 DelphiGuy 的回复:
Quote: 引用 5 楼 u010165006 的回复:

@早打大打打核战争
      for i := 0 to AList.Count - 1 do
        TIdContext(AList[i]).Connection.Disconnect;
如果Count有两个,第0个Context连接断了,第1个Context会不会自动变为第0个?


不会,这里AList := IdTCPServer1.Contexts.LockList;是获取的一个快照


当然是 for i := AList.Count - 1 downto 0 do  比较好!

#26


@sczyq 
一般有删除的动作是index从高到低索引的。

#1


不要直接IdTCPServer1->Active=false;TIdTCPSever内部维护一个连接list,如果存在连接然后Active=false,它会等待每一个连接断开,也就是如果没有主动断开,会一直到连接超时,也可能对方还在发送数据,那就一直不会断开。
大致上如此处理(未测试):
var
  AList: TIdContextList;
  i: integer;
begin
  if IdTCPServer1.Active then
  begin
    AList := IdTCPServer1.Contexts.LockList;
    try
      for i := 0 to AList.Count - 1 do
        TIdContext(AList[i]).Connection.Disconnect;
    finally
      IdTCPServer1.Contexts.UnlockList;
    end;
  end;
end;

#2


@早打大打打核战争
好,我有空试下。

IdTCPServer1->Bindings->Add()->IP="127.0.0.1";
IdTCPServer1->Bindings->Add()->Port=edtPort->Text.ToInt();
以后,如何取消绑定呢?

#3


这样写有问题,每次Add都产生一个新的TIdSocketHandle。
应该:
TIdSocketHandle *IdSocketHandle = IdTCPServer1->Bindings->Add();
IdSocketHandle->IP=...
IdSocketHandle->Port=...
IdSocketHandle->Bind();

取消绑定:
 IdTCPServer1->Bindings[i]->CloseSocket();
CloseSocket内部调用了Disconnect。

#4


@早打大打打核战争
好。我用CB2010,发现没有TIdContextList,但有TIdThreadList,但是头文件IdObjs.hpp找不到,在安装目录搜索IdObjs也没有一个文件,是不是Delphi没装Indy文件不全?

#5


@早打大打打核战争
      for i := 0 to AList.Count - 1 do
        TIdContext(AList[i]).Connection.Disconnect;
如果Count有两个,第0个Context连接断了,第1个Context会不会自动变为第0个?

#6


那你用的可能是indy9,indy10变化很大,你看看有没有source\Indy10\Core\IdContext.pas

#7


@早打大打打核战争
CB2010是Indy 10.5.5,但是文档版本是10.1.1。不知道最高版本是多少?
IdContext.pas、dcu和hpp都有。

#8


引用 5 楼 u010165006 的回复:
@早打大打打核战争
      for i := 0 to AList.Count - 1 do
        TIdContext(AList[i]).Connection.Disconnect;
如果Count有两个,第0个Context连接断了,第1个Context会不会自动变为第0个?


不会,这里AList := IdTCPServer1.Contexts.LockList;是获取的一个快照

#9


@早打大打打核战
嗯,你的机子上Indy有TIdContextList吗?

#10


有啊。
IdContext.pas
...
type
  TIdContext = class;
  TIdContextClass = class of TIdContext;
  TIdContextRun = function(AContext: TIdContext): Boolean of object;
  TIdContextEvent = procedure(AContext: TIdContext) of object;
  TIdContextExceptionEvent = procedure(AContext: TIdContext; AException: Exception) of object;

  {$IFDEF HAS_GENERICS_TThreadList}
  TIdContextThreadList = TIdThreadSafeObjectList<TIdContext>;
  TIdContextList = TList<TIdContext>;
  {$ELSE}
                                                                                                      
  TIdContextThreadList = TIdThreadSafeObjectList;
  TIdContextList = TList;
  {$ENDIF}

#11


RAD Studio 10.2里带的indy版本是10.6.2.5366

#12


你现在用10.2了?CB2010里的还是老版本,看来我也要与时俱进了。

{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
  Rev 1.14    6/16/2004 2:08:48 PM  JPMugaas
  Binding made public for the FTP Server.

  Rev 1.13    6/4/2004 1:34:24 PM  DSiders
  Removed unused TIdContextDoRun, TIdContextMethod types.

  Rev 1.12    2004.02.03 4:17:08 PM  czhower
  For unit name changes.

  Rev 1.11    21.1.2004 ? 12:31:04  DBondzhev
  Fix for Indy source. Workaround for dccil bug
  now it can be compiled using Compile instead of build

  Rev 1.10    2003.10.21 12:18:58 AM  czhower
  TIdTask support and fiber bug fixes.

  Rev 1.9    2003.10.11 5:47:18 PM  czhower
  -VCL fixes for servers
  -Chain suport for servers (Super core)
  -Scheduler upgrades
  -Full yarn support

  Rev 1.8    2003.09.19 11:54:28 AM  czhower
  -Completed more features necessary for servers
  -Fixed some bugs

  Rev 1.7    3/22/2003 09:45:26 PM  JPMugaas
  Now should compile under D4.

  Rev 1.6    3/13/2003 10:18:38 AM  BGooijen
  Server side fibers, bug fixes

  Rev 1.5    1/31/2003 7:24:18 PM  BGooijen
  Added a .Binding function

  Rev 1.4    1/23/2003 8:33:20 PM  BGooijen

  Rev 1.3    1/23/2003 11:06:06 AM  BGooijen


  Rev 1.2    1-17-2003 23:58:30  BGooijen
  removed OnCreate/OnDestroy again, they had no use

  Rev 1.0    1-17-2003 22:28:58  BGooijen
}

unit IdContext;

interface

{$i IdCompilerDefines.inc}

uses
  Classes,
  IdSocketHandle, IdTCPConnection, IdTask, IdYarn, SysUtils;

type
  TIdContext = class;
  TIdContextClass = class of TIdContext;
  TIdContextRun = function(AContext: TIdContext): Boolean of object;
  TIdContextEvent = procedure(AContext: TIdContext) of object;
  TIdContextExceptionEvent = procedure(AContext: TIdContext; AException: Exception) of object;

  TIdContext = class(TIdTask)
  protected
    // A list in which this context is registered, this can be nil, and should
    // therefore not be used
    FContextList: TThreadList;
    FConnection: TIdTCPConnection;
    FOwnsConnection: Boolean;
    FOnRun: TIdContextRun;
    FOnBeforeRun: TIdContextEvent;
    FOnAfterRun: TIdContextEvent;
    FOnException: TIdContextExceptionEvent;
    //
    procedure BeforeRun; override;
    function Run: Boolean; override;
    procedure AfterRun; override;
    procedure HandleException(AException: Exception); override;
  public
    constructor Create(
      AConnection: TIdTCPConnection;
      AYarn: TIdYarn;
      AList: TThreadList = nil
      ); reintroduce; virtual;
    destructor Destroy; override;
    procedure RemoveFromList;
    function Binding: TIdSocketHandle;
    //
    property Connection: TIdTCPConnection read FConnection;
    //
    property OnAfterRun: TIdContextEvent read FOnAfterRun write FOnAfterRun;
    property OnBeforeRun: TIdContextEvent read FOnBeforeRun write FOnBeforeRun;
    property OnRun: TIdContextRun read FOnRun write FOnRun;
    property OnException: TIdContextExceptionEvent read FOnException write FOnException;
  end;

implementation

{ TIdContext }

uses
  IdGlobal,
  IdIOHandlerSocket;

constructor TIdContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
  inherited Create(AYarn);
  FConnection := AConnection;
  FOwnsConnection := True;
  FContextList := AList;
end;

destructor TIdContext.Destroy;
begin
  if Assigned(FContextList) then begin
    FContextList.Remove(Self);
  end;

  if FOwnsConnection then begin
    FreeAndNil(FConnection);
  end;

  inherited Destroy;
end;

procedure TIdContext.RemoveFromList;
begin
  FContextList := nil;
end;

procedure TIdContext.BeforeRun;
begin
  //Context must be added to ContextList outside of create. This avoids
  //the possibility of another thread accessing a context (specifically
  //a subclass) that is still creating. similar logic for remove/destroy.
  if Assigned(FContextList) then begin
    FContextList.Add(Self);
  end;

  if Assigned(OnBeforeRun) then begin
    OnBeforeRun(Self);
  end;
end;

function TIdContext.Run: Boolean;
begin
  if Assigned(OnRun) then begin
    Result := OnRun(Self);
  end else begin
    Result := True;
  end;
end;

procedure TIdContext.AfterRun;
begin
  if Assigned(OnAfterRun) then begin
    OnAfterRun(Self);
  end;

  if FContextList <> nil then begin
    FContextList.Remove(Self);
  end;
end;

procedure TIdContext.HandleException(AException: Exception);
begin
  if Assigned(OnException) then begin
    OnException(Self, AException);
  end;
end;

function TIdContext.Binding: TIdSocketHandle;
begin
  Result := nil;
  if Connection <> nil then begin
    if Connection.Socket <> nil then begin
      Result := Connection.Socket.Binding;
    end;
  end;
end;

end.

#13


你现在用10.2了?CB2010里的还是老版本,看来我也要与时俱进了。

{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
  Rev 1.14    6/16/2004 2:08:48 PM  JPMugaas
  Binding made public for the FTP Server.

  Rev 1.13    6/4/2004 1:34:24 PM  DSiders
  Removed unused TIdContextDoRun, TIdContextMethod types.

  Rev 1.12    2004.02.03 4:17:08 PM  czhower
  For unit name changes.

  Rev 1.11    21.1.2004 ? 12:31:04  DBondzhev
  Fix for Indy source. Workaround for dccil bug
  now it can be compiled using Compile instead of build

  Rev 1.10    2003.10.21 12:18:58 AM  czhower
  TIdTask support and fiber bug fixes.

  Rev 1.9    2003.10.11 5:47:18 PM  czhower
  -VCL fixes for servers
  -Chain suport for servers (Super core)
  -Scheduler upgrades
  -Full yarn support

  Rev 1.8    2003.09.19 11:54:28 AM  czhower
  -Completed more features necessary for servers
  -Fixed some bugs

  Rev 1.7    3/22/2003 09:45:26 PM  JPMugaas
  Now should compile under D4.

  Rev 1.6    3/13/2003 10:18:38 AM  BGooijen
  Server side fibers, bug fixes

  Rev 1.5    1/31/2003 7:24:18 PM  BGooijen
  Added a .Binding function

  Rev 1.4    1/23/2003 8:33:20 PM  BGooijen

  Rev 1.3    1/23/2003 11:06:06 AM  BGooijen


  Rev 1.2    1-17-2003 23:58:30  BGooijen
  removed OnCreate/OnDestroy again, they had no use

  Rev 1.0    1-17-2003 22:28:58  BGooijen
}

unit IdContext;

interface

{$i IdCompilerDefines.inc}

uses
  Classes,
  IdSocketHandle, IdTCPConnection, IdTask, IdYarn, SysUtils;

type
  TIdContext = class;
  TIdContextClass = class of TIdContext;
  TIdContextRun = function(AContext: TIdContext): Boolean of object;
  TIdContextEvent = procedure(AContext: TIdContext) of object;
  TIdContextExceptionEvent = procedure(AContext: TIdContext; AException: Exception) of object;

  TIdContext = class(TIdTask)
  protected
    // A list in which this context is registered, this can be nil, and should
    // therefore not be used
    FContextList: TThreadList;
    FConnection: TIdTCPConnection;
    FOwnsConnection: Boolean;
    FOnRun: TIdContextRun;
    FOnBeforeRun: TIdContextEvent;
    FOnAfterRun: TIdContextEvent;
    FOnException: TIdContextExceptionEvent;
    //
    procedure BeforeRun; override;
    function Run: Boolean; override;
    procedure AfterRun; override;
    procedure HandleException(AException: Exception); override;
  public
    constructor Create(
      AConnection: TIdTCPConnection;
      AYarn: TIdYarn;
      AList: TThreadList = nil
      ); reintroduce; virtual;
    destructor Destroy; override;
    procedure RemoveFromList;
    function Binding: TIdSocketHandle;
    //
    property Connection: TIdTCPConnection read FConnection;
    //
    property OnAfterRun: TIdContextEvent read FOnAfterRun write FOnAfterRun;
    property OnBeforeRun: TIdContextEvent read FOnBeforeRun write FOnBeforeRun;
    property OnRun: TIdContextRun read FOnRun write FOnRun;
    property OnException: TIdContextExceptionEvent read FOnException write FOnException;
  end;

implementation

{ TIdContext }

uses
  IdGlobal,
  IdIOHandlerSocket;

constructor TIdContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
  inherited Create(AYarn);
  FConnection := AConnection;
  FOwnsConnection := True;
  FContextList := AList;
end;

destructor TIdContext.Destroy;
begin
  if Assigned(FContextList) then begin
    FContextList.Remove(Self);
  end;

  if FOwnsConnection then begin
    FreeAndNil(FConnection);
  end;

  inherited Destroy;
end;

procedure TIdContext.RemoveFromList;
begin
  FContextList := nil;
end;

procedure TIdContext.BeforeRun;
begin
  //Context must be added to ContextList outside of create. This avoids
  //the possibility of another thread accessing a context (specifically
  //a subclass) that is still creating. similar logic for remove/destroy.
  if Assigned(FContextList) then begin
    FContextList.Add(Self);
  end;

  if Assigned(OnBeforeRun) then begin
    OnBeforeRun(Self);
  end;
end;

function TIdContext.Run: Boolean;
begin
  if Assigned(OnRun) then begin
    Result := OnRun(Self);
  end else begin
    Result := True;
  end;
end;

procedure TIdContext.AfterRun;
begin
  if Assigned(OnAfterRun) then begin
    OnAfterRun(Self);
  end;

  if FContextList <> nil then begin
    FContextList.Remove(Self);
  end;
end;

procedure TIdContext.HandleException(AException: Exception);
begin
  if Assigned(OnException) then begin
    OnException(Self, AException);
  end;
end;

function TIdContext.Binding: TIdSocketHandle;
begin
  Result := nil;
  if Connection <> nil then begin
    if Connection.Socket <> nil then begin
      Result := Connection.Socket.Binding;
    end;
  end;
end;

end.

#14


你现在用10.2了?CB2010里的还是老版本,看来我也要与时俱进了。

{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
  Rev 1.14    6/16/2004 2:08:48 PM  JPMugaas
  Binding made public for the FTP Server.

  Rev 1.13    6/4/2004 1:34:24 PM  DSiders
  Removed unused TIdContextDoRun, TIdContextMethod types.

  Rev 1.12    2004.02.03 4:17:08 PM  czhower
  For unit name changes.

  Rev 1.11    21.1.2004 ? 12:31:04  DBondzhev
  Fix for Indy source. Workaround for dccil bug
  now it can be compiled using Compile instead of build

  Rev 1.10    2003.10.21 12:18:58 AM  czhower
  TIdTask support and fiber bug fixes.

  Rev 1.9    2003.10.11 5:47:18 PM  czhower
  -VCL fixes for servers
  -Chain suport for servers (Super core)
  -Scheduler upgrades
  -Full yarn support

  Rev 1.8    2003.09.19 11:54:28 AM  czhower
  -Completed more features necessary for servers
  -Fixed some bugs

  Rev 1.7    3/22/2003 09:45:26 PM  JPMugaas
  Now should compile under D4.

  Rev 1.6    3/13/2003 10:18:38 AM  BGooijen
  Server side fibers, bug fixes

  Rev 1.5    1/31/2003 7:24:18 PM  BGooijen
  Added a .Binding function

  Rev 1.4    1/23/2003 8:33:20 PM  BGooijen

  Rev 1.3    1/23/2003 11:06:06 AM  BGooijen


  Rev 1.2    1-17-2003 23:58:30  BGooijen
  removed OnCreate/OnDestroy again, they had no use

  Rev 1.0    1-17-2003 22:28:58  BGooijen
}

unit IdContext;

interface

{$i IdCompilerDefines.inc}

uses
  Classes,
  IdSocketHandle, IdTCPConnection, IdTask, IdYarn, SysUtils;

type
  TIdContext = class;
  TIdContextClass = class of TIdContext;
  TIdContextRun = function(AContext: TIdContext): Boolean of object;
  TIdContextEvent = procedure(AContext: TIdContext) of object;
  TIdContextExceptionEvent = procedure(AContext: TIdContext; AException: Exception) of object;

  TIdContext = class(TIdTask)
  protected
    // A list in which this context is registered, this can be nil, and should
    // therefore not be used
    FContextList: TThreadList;
    FConnection: TIdTCPConnection;
    FOwnsConnection: Boolean;
    FOnRun: TIdContextRun;
    FOnBeforeRun: TIdContextEvent;
    FOnAfterRun: TIdContextEvent;
    FOnException: TIdContextExceptionEvent;
    //
    procedure BeforeRun; override;
    function Run: Boolean; override;
    procedure AfterRun; override;
    procedure HandleException(AException: Exception); override;
  public
    constructor Create(
      AConnection: TIdTCPConnection;
      AYarn: TIdYarn;
      AList: TThreadList = nil
      ); reintroduce; virtual;
    destructor Destroy; override;
    procedure RemoveFromList;
    function Binding: TIdSocketHandle;
    //
    property Connection: TIdTCPConnection read FConnection;
    //
    property OnAfterRun: TIdContextEvent read FOnAfterRun write FOnAfterRun;
    property OnBeforeRun: TIdContextEvent read FOnBeforeRun write FOnBeforeRun;
    property OnRun: TIdContextRun read FOnRun write FOnRun;
    property OnException: TIdContextExceptionEvent read FOnException write FOnException;
  end;

implementation

{ TIdContext }

uses
  IdGlobal,
  IdIOHandlerSocket;

constructor TIdContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
  inherited Create(AYarn);
  FConnection := AConnection;
  FOwnsConnection := True;
  FContextList := AList;
end;

destructor TIdContext.Destroy;
begin
  if Assigned(FContextList) then begin
    FContextList.Remove(Self);
  end;

  if FOwnsConnection then begin
    FreeAndNil(FConnection);
  end;

  inherited Destroy;
end;

procedure TIdContext.RemoveFromList;
begin
  FContextList := nil;
end;

procedure TIdContext.BeforeRun;
begin
  //Context must be added to ContextList outside of create. This avoids
  //the possibility of another thread accessing a context (specifically
  //a subclass) that is still creating. similar logic for remove/destroy.
  if Assigned(FContextList) then begin
    FContextList.Add(Self);
  end;

  if Assigned(OnBeforeRun) then begin
    OnBeforeRun(Self);
  end;
end;

function TIdContext.Run: Boolean;
begin
  if Assigned(OnRun) then begin
    Result := OnRun(Self);
  end else begin
    Result := True;
  end;
end;

procedure TIdContext.AfterRun;
begin
  if Assigned(OnAfterRun) then begin
    OnAfterRun(Self);
  end;

  if FContextList <> nil then begin
    FContextList.Remove(Self);
  end;
end;

procedure TIdContext.HandleException(AException: Exception);
begin
  if Assigned(OnException) then begin
    OnException(Self, AException);
  end;
end;

function TIdContext.Binding: TIdSocketHandle;
begin
  Result := nil;
  if Connection <> nil then begin
    if Connection.Socket <> nil then begin
      Result := Connection.Socket.Binding;
    end;
  end;
end;

end.

#15


用Indy编写的客户/服务器程序,在客户端已连接的情况下,服务器IdTCPServer1->Active=false;会导致程序“未响应”

#16


一直回复失败,居然连发3贴,再次提交才提示已连续回复3次无法回帖。 用Indy编写的客户/服务器程序,在客户端已连接的情况下,服务器IdTCPServer1->Active=false;会导致程序“未响应”

#17


我也装上10.2了,Indy的手册Indy10.chm居然还是10.1.5的,有些有点对不上,比如
TIdIOHandler.WriteLn Method
Pascal
procedure WriteLn(
    const AOut: string = ''
); virtual;
没有字符串编码参数的重载版本,虽然这个问题已经解决了:IdTCPClient1.IOHandler.WriteLn(sendData,IndyTextEncoding(TEncoding.ANSI));  

Indy为什么不搞个最新版的手册呢?
Indy10.chm手册字体也太小了,用了个FreeChmZoomer工具才解决,麻烦了点。

#18


@早打大打打核战争
这个代码有没有问题:
//---------------------------------------------------------------------------
void __fastcall TForm1::CheckBox1Click(TObject *Sender)
{
TIdSocketHandle *IdSocketHandle;
if(CheckBox1->Checked)
{
IdSocketHandle=IdTCPServer1->Bindings->Add();
IdSocketHandle->IP="127.0.0.1";
IdSocketHandle->Port=Edit1->Text.ToInt();
     //   IdSocketHandle->Bind();
IdTCPServer1->Active=true;
}
else
{
TIdContextList *AList;
AList=IdTCPServer1->Contexts->LockList();
for(int i=0;i<AList->Count;i++)
{
TIdContext *AContext=(TIdContext *)AList->Items[i];
AContext->Connection->Disconnect();
}
IdTCPServer1->Contexts->UnlockList();

// IdSocketHandle->CloseSocket();
IdTCPServer1->Bindings->Clear();
IdTCPServer1->Active=false;
}
}
//---------------------------------------------------------------------------


IdSocketHandle->CloseSocket(); 会导致access violation错误?
这个代码,我server程序反复地选中、取消选中CheckBox1,client端对应地连接、断开连接,反复几次以后,在客户端连接的情况下,取消选中CheckBox1,会使server程序未响应,有时候连续反复3次就出现,有时候反复5、6次才出现,这个是不是代码的问题呢?

#19


你这里else部分的IdSocketHandle没有初始化,IdSocketHandle=IdTCPServer1->Bindings->Add();在if部分。另外,我前面说的不要直接IdTCPServer1->Active=false;是错的,我看了一下indy10的源码,在TCustomIdTCPServer的SetActive方法中,如果Active=false,它的处理是停止监听(StopListening),终止全部worker线程(TerminateAllThreads),然后对每个context的连接做Disconnect(DoTerminateContext),所以这样应该是可以很快停掉Server(不过我测试比手工直接逐一Disconnect要慢一点)。之所以某些时候出现程序未响应的情况是因为Disconnect事件处理是在Server的内部线程中执行的,IdTCPServer1->Active=false;的时候会调用Disconnect事件处理,在其中直接操作GUI是非线程安全的(其实Connect、Execute等等事件处理都有这个问题,只是很少碰到),要用Synchronize方法,indy已经封装了一个TIdNotify类,TIdNotify.NotifyMethod(xxx);在xxx中操作GUI。

#20


@早打大打打核战争
我这样改了一下,貌似可以了:
//---------------------------------------------------------------------------
void __fastcall TForm1::CheckBox1Click(TObject *Sender)
{
if(CheckBox1->Checked)
{
IdSocketHandle=IdTCPServer1->Bindings->Add();
IdSocketHandle->IP="127.0.0.1";
IdSocketHandle->Port=Edit1->Text.ToInt();
     //   IdSocketHandle->Bind();
IdTCPServer1->Active=true;
}
else
{
IdSocketHandle->CloseSocket();
IdTCPServer1->Bindings->Clear();
IdTCPServer1->Active=false;
}
}
//---------------------------------------------------------------------------
void __fastcall TForm1::IdTCPServer1Disconnect(TIdContext *AContext)
{
TIdNotify::NotifyMethod(ShowDisconnectMessage);
aClientConnected=false;
}
//---------------------------------------------------------------------------
void __fastcall TForm1::ShowDisconnectMessage()
{
UnicodeString s="一个客户端断开连接";
Memo1->Lines->Add(s);
}
//---------------------------------------------------------------------------

IdSocketHandle->Bind(); 似乎没必要?
TIdSocketHandle *IdSocketHandle;没注意是局部变量,改成类成员变量可以了。
操作GUI非线程安全,我的理解是GUI可能被不同线程改写导致非预期结果,为什么会导致程序未响应呢?

#21


直接调用Bind()确实没有必要。之所以导致程序未响应,因为你在主线程的事件处理中调用:
void __fastcall TForm1::CheckBox1Click(TObject *Sender)
{
//...
        IdTCPServer1->Active=false;
// ...
}
 IdTCPServer1->Active=false;实际是 IdTCPServer1->SetActive(false);方法,该方法中停止监听、终止worker线程、断开连接,断开连接中会调用Disconnect事件处理,如果在Disconnect事件处理操作GUI,比如Memo1->Lines->Add(s);,这依赖主线程中的消息循环,比如WM_SETTEXT,如果消息没有处理则Add不会完成,Disconnect事件处理不会结束,worker线程不会终止,IdTCPServer1->SetActive(false);不会返回,TForm1::CheckBox1Click不会返回,而TForm1::CheckBox1Click不返回则主线程的消息循环不会继续,消息队列中的消息得不到处理,Memo1->Lines->Add(s);无法完成,于是就陷入死锁状态了。
所以,只要在Disconnect事件处理中不进行任何依赖主线程消息处理的操作就不会有问题,比如写文件,或者AllocConsole(); printf(...);之类都没有问题。

#22


@早打大打打核战争
是不是TForm1::CheckBox1Click不返回,WM_SETTEXT消息也在队列里得不到处理,从而死锁呢?
Connect、Execute事件有这个问题为什么很少碰到呢?

#23


1. CheckBox1Click也是有消息触发的,是在消息循环中被调用的,所以它卡住了,后面的消息就得不到处理。
2. 很少碰到是说在这些事件处理中直接操作GUI是非线程安全的,不是死锁,就我看到的TIdTCPServer的代码,只有在Disconnect中直接操作GUI可能导致死锁,其他事件处理都不会,除了SetActive(false),没有其他方法等待worker线程完成再返回。

#24


@早打大打打核战争
其它事件处理中直接操作GUI是非线程安全的,不是死锁那还好,如果代码都要TIdNotify::NotifyMethod也挺繁复的。

#25


引用 8 楼 DelphiGuy 的回复:
Quote: 引用 5 楼 u010165006 的回复:

@早打大打打核战争
      for i := 0 to AList.Count - 1 do
        TIdContext(AList[i]).Connection.Disconnect;
如果Count有两个,第0个Context连接断了,第1个Context会不会自动变为第0个?


不会,这里AList := IdTCPServer1.Contexts.LockList;是获取的一个快照


当然是 for i := AList.Count - 1 downto 0 do  比较好!

#26


@sczyq 
一般有删除的动作是index从高到低索引的。