Delphi XE3,Indy TCP 服务器。关闭服务器
Delphi XE3, Indy TCP Server. Shut down server
我从本网站的另一个post改编了以下代码,但它似乎仍然卡住了。即使有客户端连接,我也必须能够关闭或断开服务器。我会等到他们发送完消息,但如果我启动服务器,从客户端连接到它,我仍然无法在不冻结的情况下关闭服务器。然后我必须关闭 Windows 任务管理器。
procedure TTasksForm.ShutDownPantherServer;
var i : integer ;
Context: TidContext;
begin
if PantherIdTCPServer.Active = True then
with PantherIdTCPServer.Contexts.LockList do
try
for i := (PantherIdTCPServer.Contexts.LockList.Count - 1) downto 0 do
begin
Context := Items[i] ;
if Context = nil then
Continue;
Context.Connection.IOHandler.WriteBufferClear;
Context.Connection.IOHandler.InputBuffer.Clear;
Context.Connection.IOHandler.Close;
if Context.Connection.Connected then
Context.Connection.Disconnect;
end;
finally
PantherIdTCPServer.Contexts.UnLockList ;
end ;
if PantherIdTCPServer.Active = True then
PantherIdTCPServer.Active := False ;
end;
补充信息...
我使用以下代码连接到服务器。当它连接时,服务器发回一条消息,表明已建立连接。
客户端连接到服务器
procedure TPantherSimulatorForm.ConnectToServer ;
var MsgIn : String ;
begin
PantherIdTCPClient.Host := IPAddressEdit.Text ;
PantherIdTCPClient.Port := StrToInt(PortEdit.Text) ;
PantherIdTCPClient.Connect;
MsgIn := PantherIdTCPClient.IOHandler.ReadLn();
TThread.Synchronize(nil,
procedure
begin
ClientTrafficMemo.Clear ;
ClientTrafficMemo.Lines.Add(FormatDateTime( 'yyyy-mm-dd hh:nn:ss.zzz', now ) +
' ' + MsgIn) ;
end ) ;
end;
服务器上的 OnConnect
procedure TTasksForm.PantherIdTCPServerConnect(AContext: TIdContext);
begin
AContext.Connection.IOHandler.DefStringEncoding := Indy8BitEncoding ;
TThread.Synchronize(nil,
procedure
begin
ServerTrafficMemo.Lines.Add(FormatDateTime( 'yyyy-mm-dd hh:nn:ss.zzz', now ) +
' OnConnect') ;
end );
// connected message
AContext.Connection.IOHandler.WriteLn('Connected');
end;
如果我不先关闭客户端,当我尝试关闭服务器程序时,这两个过程的组合将导致服务器冻结。抱歉,我对 Indy 太陌生了,看不出问题是什么或如何进行线程工作来解决问题。我希望您能在 2 个连接过程之一中看到我的初学者错误。
这是 OnExecute 代码:
procedure TForm2.PantherIdTCPServerExecute(AContext: TIdContext);
begin
Sleep(1000) ;
TThread.Queue(nil,
procedure
begin
ServerTrafficMemo.Lines.Add(FormatDateTime( 'yyyy-mm-dd hh:nn:ss.zzz', now ) +
' OnExecute') ;
end ) ;
end;
您的 with
语句正在调用 Contexts.LockList()
然后您的循环再次调用 Contexts.LockList()
,但您只在循环完成后调用 Contexts.UnlockList()
一次。因此,Contexts
列表仍然被锁定,任何其他线程的任何进一步访问都将无限期地死锁,包括客户端线程,当它们试图将自己从 Contexts
列表中删除时,这反过来会死锁Active
属性 setter 因为它等待所有客户端线程终止。
在您的循环中,将 PantherIdTCPServer.Contexts.LockList.Count
替换为简单的 Count
,因为 with
作用于 LockList()
返回的 TList
:
procedure TTasksForm.ShutDownPantherServer;
var
i : integer ;
Context: TidContext;
begin
if PantherIdTCPServer.Active = True then
with PantherIdTCPServer.Contexts.LockList do
try
// HERE!!!
for i := ({PantherIdTCPServer.Contexts.LockList.}Count - 1) downto 0 do
begin
Context := Items[i] ;
if Context = nil then
Continue;
Context.Connection.IOHandler.WriteBufferClear;
Context.Connection.IOHandler.InputBuffer.Clear;
Context.Connection.IOHandler.Close;
if Context.Connection.Connected then
Context.Connection.Disconnect;
end;
finally
PantherIdTCPServer.Contexts.UnLockList ;
end ;
if PantherIdTCPServer.Active = True then
PantherIdTCPServer.Active := False ;
end;
事实上,您展示的所有代码都是完全多余的,应该删除,这就是您所需要的:
procedure TTasksForm.ShutDownPantherServer;
begin
PantherIdTCPServer.Active := False;
end;
它已经完成了断开活动客户端、清除 Contexts
列表和关闭服务器的所有艰苦工作。您根本不需要手动执行这些操作。
我从本网站的另一个post改编了以下代码,但它似乎仍然卡住了。即使有客户端连接,我也必须能够关闭或断开服务器。我会等到他们发送完消息,但如果我启动服务器,从客户端连接到它,我仍然无法在不冻结的情况下关闭服务器。然后我必须关闭 Windows 任务管理器。
procedure TTasksForm.ShutDownPantherServer;
var i : integer ;
Context: TidContext;
begin
if PantherIdTCPServer.Active = True then
with PantherIdTCPServer.Contexts.LockList do
try
for i := (PantherIdTCPServer.Contexts.LockList.Count - 1) downto 0 do
begin
Context := Items[i] ;
if Context = nil then
Continue;
Context.Connection.IOHandler.WriteBufferClear;
Context.Connection.IOHandler.InputBuffer.Clear;
Context.Connection.IOHandler.Close;
if Context.Connection.Connected then
Context.Connection.Disconnect;
end;
finally
PantherIdTCPServer.Contexts.UnLockList ;
end ;
if PantherIdTCPServer.Active = True then
PantherIdTCPServer.Active := False ;
end;
补充信息...
我使用以下代码连接到服务器。当它连接时,服务器发回一条消息,表明已建立连接。
客户端连接到服务器
procedure TPantherSimulatorForm.ConnectToServer ;
var MsgIn : String ;
begin
PantherIdTCPClient.Host := IPAddressEdit.Text ;
PantherIdTCPClient.Port := StrToInt(PortEdit.Text) ;
PantherIdTCPClient.Connect;
MsgIn := PantherIdTCPClient.IOHandler.ReadLn();
TThread.Synchronize(nil,
procedure
begin
ClientTrafficMemo.Clear ;
ClientTrafficMemo.Lines.Add(FormatDateTime( 'yyyy-mm-dd hh:nn:ss.zzz', now ) +
' ' + MsgIn) ;
end ) ;
end;
服务器上的 OnConnect
procedure TTasksForm.PantherIdTCPServerConnect(AContext: TIdContext);
begin
AContext.Connection.IOHandler.DefStringEncoding := Indy8BitEncoding ;
TThread.Synchronize(nil,
procedure
begin
ServerTrafficMemo.Lines.Add(FormatDateTime( 'yyyy-mm-dd hh:nn:ss.zzz', now ) +
' OnConnect') ;
end );
// connected message
AContext.Connection.IOHandler.WriteLn('Connected');
end;
如果我不先关闭客户端,当我尝试关闭服务器程序时,这两个过程的组合将导致服务器冻结。抱歉,我对 Indy 太陌生了,看不出问题是什么或如何进行线程工作来解决问题。我希望您能在 2 个连接过程之一中看到我的初学者错误。
这是 OnExecute 代码:
procedure TForm2.PantherIdTCPServerExecute(AContext: TIdContext);
begin
Sleep(1000) ;
TThread.Queue(nil,
procedure
begin
ServerTrafficMemo.Lines.Add(FormatDateTime( 'yyyy-mm-dd hh:nn:ss.zzz', now ) +
' OnExecute') ;
end ) ;
end;
您的 with
语句正在调用 Contexts.LockList()
然后您的循环再次调用 Contexts.LockList()
,但您只在循环完成后调用 Contexts.UnlockList()
一次。因此,Contexts
列表仍然被锁定,任何其他线程的任何进一步访问都将无限期地死锁,包括客户端线程,当它们试图将自己从 Contexts
列表中删除时,这反过来会死锁Active
属性 setter 因为它等待所有客户端线程终止。
在您的循环中,将 PantherIdTCPServer.Contexts.LockList.Count
替换为简单的 Count
,因为 with
作用于 LockList()
返回的 TList
:
procedure TTasksForm.ShutDownPantherServer;
var
i : integer ;
Context: TidContext;
begin
if PantherIdTCPServer.Active = True then
with PantherIdTCPServer.Contexts.LockList do
try
// HERE!!!
for i := ({PantherIdTCPServer.Contexts.LockList.}Count - 1) downto 0 do
begin
Context := Items[i] ;
if Context = nil then
Continue;
Context.Connection.IOHandler.WriteBufferClear;
Context.Connection.IOHandler.InputBuffer.Clear;
Context.Connection.IOHandler.Close;
if Context.Connection.Connected then
Context.Connection.Disconnect;
end;
finally
PantherIdTCPServer.Contexts.UnLockList ;
end ;
if PantherIdTCPServer.Active = True then
PantherIdTCPServer.Active := False ;
end;
事实上,您展示的所有代码都是完全多余的,应该删除,这就是您所需要的:
procedure TTasksForm.ShutDownPantherServer;
begin
PantherIdTCPServer.Active := False;
end;
它已经完成了断开活动客户端、清除 Contexts
列表和关闭服务器的所有艰苦工作。您根本不需要手动执行这些操作。