Indy / lazarus TIdTCPServer如何正确关闭

时间:2014-05-25 14:35:00

标签: sockets indy lazarus

如果我们按下GUI中的“关闭”按钮,如何使用Indy / Lazarus正确关闭TIdTCPServer?谢谢你的帮助! (改变了我原来的问题)

如果客户端断开连接,如何关闭TIdTCPServer?

异常应该处理什么吗?

IO工作但它有点不稳定。 以下是代码:

unit pt_socket;

{$mode objfpc}//{$H+}

interface

uses
  Classes, SysUtils,
  Forms,
  IdGlobal,
  IdContext, IdComponent,
  IdTCPServer, IdTCPClient,
  Controls, Graphics, Dialogs;

type
  TSocket = class
  private
    IdTcpServer1: TIdTCPServer;
    IdTcpClient1: TIdTCPClient;
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    //procedure IdTCPServer1Exception(AContext: TIdContext; AException: Exception);
    procedure IdTCPServer1Execute(AContext: TIdContext);
  public
    procedure init;
    function Open: boolean;
    procedure Close;
    function Write(str: TByteArray; len: integer): integer;
  end;

var
  lst: Tlist;

implementation

uses main, pt_settings, pt_ctlpanel, pt_terminal;

procedure TSocket.init;
begin
end;

procedure TSocket.IdTCPServer1Connect(AContext: TIdContext);
begin
  MainApp.GuiPortOpen;
  lst := IdTcpServer1.Contexts.LockList;
end;

procedure TSocket.IdTCPServer1Disconnect(AContext: TIdContext);
begin
  IdTcpServer1.Contexts.UnlockList;
  MainApp.GuiPortClose;
end;

//procedure TSocket.IdTCPServer1Exception(AContext: TIdContext; AException: Exception);
//begin
//    MainApp.GuiPortClose;
//end;

procedure TSocket.IdTCPServer1Execute(AContext: TIdContext);
var
  Socket_Receive_Buffer: TIdBytes;
  Socket_Input_Length: integer;
  Input_Buffer: TByteArray;

begin
  with AContext.Connection do
  begin
    IOHandler.ReadBytes(Socket_Receive_Buffer, -1, false);
    Socket_Input_Length := Length(Socket_Receive_Buffer);
    if Socket_Input_Length > 0 then
    begin
      BytesToRaw(Socket_Receive_Buffer,Input_Buffer,Socket_Input_Length);
      Terminal.GuiTerminalPutInput(Input_Buffer, Socket_Input_Length);
    end;
  end;
end;

function TSocket.Open: boolean;
begin
  if Settings.SocketModeRadioGroup.ItemIndex = 0 then
  begin
    IdTcpServer1 := TIdTCPServer.Create(nil);
    IdTCPServer1.OnExecute := @IdTCPServer1Execute;
    IdTCPServer1.OnConnect := @IdTCPServer1Connect;
    IdTCPServer1.OnDisconnect := @IdTCPServer1Disconnect;
    //IdTcpServer1.OnException := @IdTCPServer1Exception;
    IdTcpServer1.DefaultPort := StrToInt(Settings.SocketPortEdit.Text);
    IdTcpServer1.MaxConnections := 1;
    IdTCPServer1.Bindings.Add.IPVersion := Id_IPv4;
    IdTcpServer1.Active := True;
  end
  else
  begin
    IdTcpClient1 := TIdTCPClient.Create(nil);
    //IdTcpClient1.DefaultPort := StrToInt(Settings.SocketPortEdit.SelText);
  end;
end;

procedure TSocket.Close;
begin
  if Settings.SocketModeRadioGroup.ItemIndex = 0 then
  begin
    IdTcpServer1.Destroy;
  end
  else
  begin
    IdTcpClient1.Destroy;
  end;
end;

function TSocket.Write(str: TByteArray; len: integer): integer;
var
  Socket_Transmit_Buffer: TIdBytes;

begin
  Socket_Transmit_Buffer := RawToBytes(str,len);
  if len > 0 then

  // Only one connection by design
  with TIdContext(lst.Items[0]).Connection do
  begin
    IOHandler.Write(Socket_Transmit_Buffer);
  end;
  Result := len;
end;

end.

1 个答案:

答案 0 :(得分:1)

此代码中存在大量错误。滥用Contexts列表。使用不当BytesToRaw()RawToBytes()。工作线程中的线程不安全的GUI逻辑。此代码非常容易出现内存损坏和死锁。难怪你的代码不稳定。你需要解决这个问题。

回答您的具体问题:

  

如果我们按下'关闭'如何使用Indy / Lazarus正确关闭TIdTCPServer? GUI中的按钮?。

只需停用/销毁服务器即可。它将自动关闭任何活动的客户端连接。但是,由于TIdTCPServer的多线程特性,您必须确保在停用期间不阻止任何服务器的事件处理程序,否则您将使代码死锁。如果事件处理程序在主线程停用服务器时必须与主线程同步,请使用异步同步(TThread.Queue()TIdNotify等)或在工作线程中停用,以便主线程没有被阻止。此外,如果您需要在事件处理程序中捕获异常,请务必重新引发您捕获的任何EIdException派生的异常并让服务器处理它,否则客户端线程将无法正确终止,也会导致死锁停用

  

如果客户端断开连接,如何关闭TIdTCPServer?

无法从自己的事件(死锁)内部停用服务器。您必须异步执行停用。在OnDisconnect事件中,您可以向自己发送异步信号,以便事件处理程序可以退出,然后在处理信号时停用服务器。或者生成一个工作线程来执行停用。