Question

我在Raspberry PI上使用Indy 10.6 tcpserver设置了一个新系统，并加载了最新的Raspbian。我通过带有sudo的终端bash脚本从GUI桌面运行应用程序。一切正常，直到客户端连接，然后当它断开连接时，我得到Gtk-WARNING，有时Gtk-CRITICALs，我不知道为什么。这是我的代码，它一次只允许一个客户端连接，然后它会停用服务器并在每次连接完成后重新启动它：

Procedure TFK20Elevator.ASpeedBtn1Click(Sender: TObject);
Begin //start the server
  Server.Active := False;
  Server.Bindings.Clear;
  Server.Bindings.Add.IPVersion := Id_IPv4;
  Server.Bindings.Add.IP := LIP;
  Server.Bindings.Add.Port := DefPort + StrToIntDef(UnitID, 0);
  Try
    Server.Active := True;
  Except
    On E: Exception Do
      Memo1.Lines.Add(E.Message);
  End;
  If Not Server.Active Then
    Exit;
  ASpeedBtn1.Enabled := False;
  ASpeedBtn2.Enabled := True;
  AStatus1.SimpleText := 'Server bound to ' + LIP + ':' + IntToStr(DefPort + StrToIntDef(UnitID, 0));
End;

Procedure TFK20Elevator.ServerConnect(AContext: TIdContext);
Begin
  If Connected Then
    Begin
      Abort();
      Exit;
    End;
  AStatus1.SimpleText := 'Connecting to> ' + AContext.Binding.PeerIP + ' - Authenticating...';
  Memo1.Lines.Clear;
  Manager := False;
  EncDecSIdx := 1;
  RetryTimer.Enabled := False;
  RetryTimer.Interval := 3000;
  Authenticating := True;
  AuthTimer.Enabled := True;
  StayAlive.Enabled := True;
End;

Procedure TFK20Elevator.ServerException(AContext: TIdContext; AException: Exception);
Begin
  If AnsiContainsText(AException.Message, 'Gracefully') Then
    AStatus1.SimpleText := 'Server bound to ' + LIP + ':' + IntToStr(DefPort + StrToIntDef(UnitID, 0)) //closed gracefully message
  Else
    Begin //show the exception
      Memo1.Lines.Add('An exception happend! - ' + AException.Message);
      RetryTimer.Enabled := True;
    End;
  Manager := False;
  Authenticating := False;
End;

Procedure TFK20Elevator.ServerExecute(AContext: TIdContext);
//EncStr and DecStr simply encode/decode, respectively, a standard
//  string into/from a key encrypted hex string, i.e. '00' to 'FF'
//  for each character in the string
Var
  S, UserName, Password: String;
  I, N: Integer;
Begin
  S := AContext.Connection.IOHandler.ReadLn(IndyTextEncoding_OSDefault, IndyTextEncoding_OSDefault); //get the data
  If S = Heart Then //if message is the client heart beat, return to client
    Begin //just a heart beat, reset timer
      StayAlive.Enabled := False;
      AContext.Connection.IOHandler.WriteLn(Heart, IndyTextEncoding_OSDefault, IndyTextEncoding_OSDefault);
      StayAlive.Enabled := True;
      Exit;
    End;
  S := PCommon.DecStr(S, EncDecStr, EncDecSIdx); //not heart beat, decompress
  If Authenticating Then
    Begin //test log in
      If Length(S) > 3 Then
        Begin
          I := Pos('|', S);
          If (I > 1) And (Length(S) > I) Then
            Begin
              UserName := Copy(S, 1, I - 1);
              Password := Copy(S, I + 1, Length(S) - I);
              If UserName = ManUser Then
                Begin
                  If Password = ManPass Then
                    Begin
                      AuthTimer.Enabled := False;
                      Manager := True;
                      Authenticating := False;
                      AContext.Connection.IOHandler.WriteLn(EncStr(AContext.Binding.PeerIP +
                                                            ':' + IntToStr(DefPort + StrToIntDef(UnitID, 0)) + 'M',
                                                            EncDecStr, EncDecSIdx), IndyTextEncoding_OSDefault,
                                                            IndyTextEncoding_OSDefault);
                      AStatus1.SimpleText := 'Connecting to> ' + AContext.Binding.PeerIP + ' as Manager';
                      Connected := True;
                    End
                  Else
                    AuthTimerTimer(Self);
                End
              Else If UserName = GenUser Then
                Begin
                  If Password = GenPass Then
                    Begin
                      AuthTimer.Enabled := False;
                      Authenticating := False;
                      AContext.Connection.IOHandler.WriteLn(EncStr(AContext.Binding.PeerIP +
                                                            ':' + IntToStr(DefPort + StrToIntDef(UnitID, 0)) + 'U',
                                                            EncDecStr, EncDecSIdx), IndyTextEncoding_OSDefault,
                                                            IndyTextEncoding_OSDefault);
                      AStatus1.SimpleText := 'Connecting to> ' + AContext.Binding.PeerIP + ' as General User';
                      Connected := True;
                    End
                  Else
                    AuthTimerTimer(Self);
                End
              Else
                AuthTimerTimer(Self);
            End
          Else
            AuthTimerTimer(Self);
        End
      Else
        AuthTimerTimer(Self);
    End
  Else
    Begin //test for commands
      If Copy(S, 1, Length(AssignID)) = AssignID Then
        Begin //command to assign a new unit id
          NewLoc := DefLocation;
          NewUnit := DefUnitNum;
          I := Pos('-', S, 1);
          If (I > 0) And (I < Length(S)) Then
            Begin
              N := Pos('-', S, I + 1);
              If (N > 0) And (N < Length(S)) Then
                Begin
                  NewLoc := Copy(S, I + 1, N - I - 1);
                  NewUnit := Copy(S, N + 1, Length(S) - N);
                End;
            End;
          Label15.Caption := NewLoc;
          Label16.Caption := NewUnit;
          FmtStr(LIP, '%.3d', [StrToInt(NewUnit)]);
          LIP := '192.168.6' + Copy(LIP, 1, 1) + '.' + Copy(LIP, 2, 2); //wifi ip
          Memo1.Lines.Add('--> ' + S + '-' + LIP);
          AContext.Connection.IOHandler.WriteLn(PCommon.EncStr(Rebooting, EncDecStr, EncDecSIdx),
                                                IndyTextEncoding_OSDefault, IndyTextEncoding_OSDefault);
          Memo1.Lines.Add('<-- ' + Rebooting);
          TestTimer.Enabled := True;
        End;
    End;
End;

Procedure TFK20Elevator.ASpeedBtn2Click(Sender: TObject);
Begin //shut down the server with optional restart if not rebooting
  AuthTimer.Enabled := False;
  RetryTimer.Enabled := False;
  StayAlive.Enabled := False;
  TestTimer.Enabled := False;
  DropClient;
  Try
    Server.Active := False;
  Except
    On E: Exception Do
      Memo1.Lines.Add('Error disconnecting server - ' + E.Message);
  End;
  If Server.Active Then
    Exit;
  ASpeedBtn1.Enabled := True;
  ASpeedBtn2.Enabled := False;
  AStatus1.SimpleText := 'Server not running...';
  Manager := False;
  Authenticating := False;
  Connected := False;
  RetryTimer.Enabled := Not SysReboot;
End;

Procedure TFK20Elevator.ServerDisconnect(AContext: TIdContext);
Begin
  StayAlive.Enabled := False;
  RetryTimer.Enabled := False;
  DropClient;
  AStatus1.SimpleText := 'Client disconnected...';
  Manager := False;
  Authenticating := False;
  Connected := False;
  RetryTimer.Enabled := Not SysReboot;
End;

Procedure TFK20Elevator.DropClient; //make sure buffers are cleared
Var
  I: Integer;
  SC: TIdContext;
Begin
  If Server.Active Then
    Begin
      Application.ProcessMessages;
      With Server.Contexts.LockList Do
        Try
          Memo1.Lines.Add('Disconnecting...');
          For I := Count - 1 DownTo 0 Do
            Begin
              SC := TIdContext(Items[I]);
              If SC = Nil Then
                Continue;
              SC.Connection.IOHandler.WriteBufferClear;
              SC.Connection.IOHandler.InputBuffer.Clear;
              SC.Connection.IOHandler.Close;
              If SC.Connection.Connected Then
                SC.Connection.Disconnect;
              Memo1.Lines.Add('Disconnecting client ' + IntToStr(I + 1) + ' of ' + IntToStr(Count));
            End;
        Finally
          Server.Contexts.UnlockList;
          Memo1.Lines.Add('Disconnected');
        End;
    End;
End;

Procedure TFK20Elevator.StayAliveTimer(Sender: TObject);
Begin //server reset timer if client stops sending heart beat
  StayAlive.Enabled := False;
  AStatus1.SimpleText := 'Client timed out!';
  If ASpeedBtn2.Enabled Then
    ASpeedBtn2Click(Self);
End;

Procedure TFK20Elevator.AuthTimerTimer(Sender: TObject);
Begin //login authorization timeout timer
  AuthTimer.Enabled := False;
  ASpeedBtn2Click(Self);
  Application.ProcessMessages;
  ASpeedBtn1Click(Self);
End;

Answer 1

 Server.Bindings.Add.IPVersion := Id_IPv4;
 Server.Bindings.Add.IP := LIP;
 Server.Bindings.Add.Port := DefPort + StrToIntDef(UnitID, 0);

这是您的代码中的错误。你不是只打开一个监听套接字，你实际上是打开3个监听套接字！每次调用Bindings.Add()都会告诉TIdTCPServer创建一个单独的侦听套接字，并且每个Binding对象都有自己的IP /端口设置。

您使用上述代码的确是：

在端口0.0.0.0上的IP TIdTCPServer.DefaultPort上创建IPv4绑定。
在端口LIP上使用Indy的默认IP版本（恰好是IPv4，在IP TIdTCPServer.DefaultPort上创建另一个绑定，除非您使用{{1}中定义的IdIPv6重新编译Indy }}）。
在端口IdCompilerDefines.inc上创建另一个绑定IP 0.0.0.0或::1，具体取决于Indy的默认IP版本。

对于您尝试执行的操作，您只需拨打DefPort+UnitID 一次，例如：

Bindings.Add()

话虽如此，var Binding : TIdSocketHandle; Binding := Server.Bindings.Add; Binding.IPVersion := Id_IPv4; Binding.IP := LIP; Binding.Port := DefPort + StrToIntDef(UnitID, 0);是一个多线程组件。其各种事件（TIdTCPServer，OnConnect，OnDisconnect，OnExecute和OnException）在{{1}内部创建的工作线程的上下文中触发}。您的事件处理程序直接从主UI线程的上下文访问UI控件。这会导致各种各样的问题，绝不能这样做。

如果您的事件处理程序需要访问您的UI，他们必须与主UI线程同步，例如与OnListenException或TIdTCPServer或Indy自己的TThread.Synchronize()或{{1} } class，或您选择的任何其他线程间同步机制。

此外，当您使用TThread.Queue()手动删除客户端时，它正在处理它没有业务的上下文。您甚至无需手动删除客户端，因为TIdSync会在您停用时为您处理。

所有这些都说，尝试更像这样的事情：

TIdNotify

最后，我建议您考虑从主UI线程中删除所有全局变量和心跳/身份验证计时器。请在DropClient()事件本身内部执行超时处理，例如使用客户端的TIdTCPServer属性和/或interface uses Classes, Form, SysUtils, StdCtrls, ExtCtrls, Buttons, IdTCPServer, IdContext; type TFK20Elevator = class(TForm) Server: TIdTCPServer; ASpeedBtn1: TSpeedButton; ASpeedBtn2: TSpeedButton; Memo1: TMemo; AStatus1: TStatusBar; AuthTimer: TTimer; RetryTimer: TTimer; StayAlive: TTimer; TestTimer: TTimer; ... procedure ASpeedBtn1Click(Sender: TObject); procedure ASpeedBtn2Click(Sender: TObject); procedure StayAliveTimer(Sender: TObject); procedure AuthTimerTimer(Sender: TObject); procedure ServerConnect(AContext: TIdContext); procedure ServerDisconnect(AContext: TIdContext); procedure ServerException(AContext: TIdContext; AException: Exception); procedure ServerExecute(AContext: TIdContext); ... private DefPort: Integer; UnitID: string; Manager: Boolean; Authenticating: Boolean; EncDecSIdx: Integer; ... procedure DropClient; procedure ConnectedNotify(const APeerIP: string); procedure DisconnectedNotify; procedure ErrorNotify(const AMessage: string); procedure HeartNotify; procedure ManagerLoggedInNotify(const APeerIP: string); procedure GeneralUserLoggedInNotify(const APeerIP: string); procedure FailedAuthNotify; procedure RebootNotify(const Data: string); ... end; var FK20Elevator: TFK20Elevator; implementation uses IdGlobal, IdSync; const Heart: string = ...; AssignID: string = ...; ... procedure TFK20Elevator.ASpeedBtn1Click(Sender: TObject); var Binding: TIdSocketHandle; begin //start the server Server.Active := False; Server.Bindings.Clear; Binding := Server.Bindings.Add; Binding.IPVersion := Id_IPv4; Binding.IP := LIP; Binding.Port := DefPort + StrToIntDef(UnitID, 0); Server.MaxConnections := 1; try Server.Active := True; except on E: Exception do begin Memo1.Lines.Add('Error activating server - ' + E.Message); Exit; end; end; AStatus1.SimpleText := 'Server bound to ' + Binding.IP + ':' + IntToStr(Binding.Port); ASpeedBtn1.Enabled := False; ASpeedBtn2.Enabled := True; end; procedure TFK20Elevator.ASpeedBtn2Click(Sender: TObject); begin //shut down the server with optional restart if not rebooting AuthTimer.Enabled := False; RetryTimer.Enabled := False; StayAlive.Enabled := False; TestTimer.Enabled := False; try Server.Active := False; except on E: Exception do begin Memo1.Lines.Add('Error deactivating server - ' + E.Message); Exit; end; end; Manager := False; Authenticating := False; AStatus1.SimpleText := 'Server not running...'; ASpeedBtn1.Enabled := True; ASpeedBtn2.Enabled := False; RetryTimer.Enabled := not SysReboot; end; procedure TFK20Elevator.StayAliveTimer(Sender: TObject); begin //client stopped sending heart beats StayAlive.Enabled := False; Memo1.Lines.Add('Client timed out!'); DropClient; end; procedure TFK20Elevator.AuthTimerTimer(Sender: TObject); begin //login authorization timeout AuthTimer.Enabled := False; Memo1.Lines.Add('Authentication timed out!'); DropClient; end; procedure TFK20Elevator.DropClient; begin with Server.Contexts.LockList do try if Count > 0 then TIdContext(Items[0]).Connection.Disconnect; finally Server.Contexts.UnlockList; end; end; type TMyNotifyMethod = procedure(const AStr: string) of object; TMyNotify = class(TIdNotify) protected FMethod: TMyNotifyMethod; FStr: string; procedure DoNotify; override; public class procedure NotifyStr(AMethod: TMyNotifyMethod; const AStr: string); end; procedure TMyNotify.DoNotify; begin FMethod(FStr); end; class procedure TMyNotify.NotifyStr(AMethod: TMyNotifyMethod; const AStr: string); begin with Create do begin FMethod := AMethod; FStr := AStr; Notify; end; end; procedure TFK20Elevator.ConnectedNotify(const APeerIP: string); begin if not Server.Active then Exit; AStatus1.SimpleText := 'Connecting to> ' + APeerIP + ' - Authenticating...'; Memo1.Lines.Clear; RetryTimer.Enabled := False; RetryTimer.Interval := 3000; AuthTimer.Enabled := True; StayAlive.Enabled := True; end; procedure TFK20Elevator.DisconnectedNotify; begin StayAlive.Enabled := False; RetryTimer.Enabled := False; if Server.Active then begin with Server.Bindings[0] do AStatus1.SimpleText := 'Client Disconnected. Server bound to ' + IP + ':' + IntToStr(Port); end; RetryTimer.Enabled := Not SysReboot; end; procedure TFK20Elevator.ErrorNotify(const AMessage: string); begin Memo1.Lines.Add('An exception happened! - ' + AMessage); RetryTimer.Enabled := True; end; procedure TFK20Elevator.HeartNotify; begin StayAlive.Enabled := False; StayAlive.Enabled := True; end; procedure TFK20Elevator.ManagerLoggedInNotify(const APeerIP: string); begin AuthTimer.Enabled := False; AStatus1.SimpleText := 'Connecting to> ' + APeerIP + ' as Manager'; end; procedure TFK20Elevator.GeneralUserLoggedInNotify(const APeerIP: string); begin AuthTimer.Enabled := False; AStatus1.SimpleText := 'Connecting to> ' + APeerIP + ' as General User'; end; procedure TFK20Elevator.FailedAuthNotify; begin //login authorization failed AuthTimer.Enabled := False; end; procedure TFK20Elevator.RebootNotify(const Data: string); var Tmp, S, NewLoc, NewUnit, LIP: string; begin Tmp := Data; S := Fetch(Tmp, #10); NewLoc := Fetch(Tmp, #10); NewUnit := Tmp; Label15.Caption := NewLoc; Label16.Caption := NewUnit; FmtStr(LIP, '%.3d', [StrToInt(NewUnit)]); LIP := '192.168.6' + Copy(LIP, 1, 1) + '.' + Copy(LIP, 2, 2); //wifi ip Memo1.Lines.Add('--> ' + S + '-' + LIP); Memo1.Lines.Add('<-- ' + Rebooting); TestTimer.Enabled := True; end; procedure TFK20Elevator.ServerConnect(AContext: TIdContext); begin Manager := False; Authenticating := True; EncDecSIdx := 1; TMyNotify.NotifyStr(@ConnectedNotify, AContext.Binding.PeerIP); // Note: OSDefault is platform-specific. On Linux, it is UTF-8, so // you should use UTF-8 explicitly instead, so as to provide // better compatibility across platforms, especially if you ever // move this server code to another platform in the future... // AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_OSDefault; // IndyTextEncoding_UTF8 AContext.Connection.IOHandler.DefAnsiEncoding := IndyTextEncoding_OSDefault; // IndyTextEncoding_UTF8 end; procedure TFK20Elevator.ServerDisconnect(AContext: TIdContext); begin Manager := False; Authenticating := False; TIdNotify.NotifyMethod(@DisconnectedNotify); end; procedure TFK20Elevator.ServerException(AContext: TIdContext; AException: Exception); begin if not (AException is EIdConnClosedGracefully) then TMyNotify.NotifyStr(@ErrorNotify, AException.Message); end; procedure TFK20Elevator.ServerExecute(AContext: TIdContext); var S, Tmp, UserName, Password: String; begin S := AContext.Connection.IOHandler.ReadLn; //get the data if S = Heart then begin //just a heart beat, return to client and reset timer AContext.Connection.IOHandler.WriteLn(Heart); TIdNotify.NotifyMethod(@HeartNotify); Exit; end; //not heart beat, decompress //EncStr and DecStr simply encode/decode, respectively, a standard // string into/from a key encrypted hex string, i.e. '00' to 'FF' // for each character in the string S := PCommon.DecStr(S, EncDecStr, EncDecSIdx); if Authenticating then begin //test log in UserName := Fetch(S, '|'); Password := S; if (UserName = ManUser) and (Password = ManPass) then begin Authenticating := False; Manager := True; AContext.Connection.IOHandler.WriteLn(EncStr(AContext.Binding.PeerIP + ':' + IntToStr(AContext.Binding.Port) + 'M', EncDecStr, EncDecSIdx)); TMyNotify.NotifyStr(@ManagerLoggedInNotify, AContext.Binding.PeerIP); end else if (UserName = GenUser) and (Password = GenPass) then begin Authenticating := False; AContext.Connection.IOHandler.WriteLn(EncStr(AContext.Binding.PeerIP + ':' + IntToStr(AContext.Binding.Port) + 'U', EncDecStr, EncDecSIdx)); TMyNotify.NotifyStr(@GeneralUserLoggedInNotify, AContext.Binding.PeerIP); end else begin TIdNotify.NotifyMethod(@FailedAuthNotify); AContext.Connection.Disconnect; end; Exit; end; //test for commands if TextStartsWith(S, AssignID) then begin //command to assign a new unit id Tmp := S; Fetch(Tmp, '-'); NewLoc := Fetch(Tmp, '-'); NewUnit := Tmp; if (NewLoc = '') or (NewUnit = '') then begin NewLoc := DefLocation; NewUnit := DefUnitNum; end; AContext.Connection.IOHandler.WriteLn(PCommon.EncStr(Rebooting, EncDecStr, EncDecSIdx)); TMyNotify.NotifyStr(@RebootNotify, S + #10 + NewLoc + #10 + NewUnit); end; end;方法。使用OnExecute属性（或从ReadTimeout派生一个新类并将其分配给CheckForDataOnSource()属性）以跟踪每个连接值，就像上次收到心跳时一样，或者客户端是否仍在进行身份验证（实际上，您应该在TIdContext.Data开始运行之前在TIdServerContext中处理身份验证），或者客户端是否以管理员身份登录等等。这将减少数量需要与主UI线程同步的事情，并避免同步处理延迟引起的任何时序问题。

在客户端断开

1 个答案: