TIdTCPServer: OnExecute-Schleife trotz Disconnect

[Windwalker]

Klar!

OnExecute:

Delphi-Quellcode:

procedure TmyService.IdTCPServerExecute(AContext: TIdContext);
var
  cli :TClient;
  s, s1 : string;
  i, laenge :integer;
  fehler : boolean;
  ThreadKey : string;
begin
  // Hier reagiert der Server auf eingehende Nachrichten
  try
    fehler := FALSE;
    ThreadKey := get_key(AContext);
    i:=client_list.IndexOf(ThreadKey);
    if i >= 0 then
    begin
      cli := TClient(client_list.objects[i]);
      log('Anfrage von Client '+cli.host,0);
      while (not fehler) and (AContext.Connection.Connected) do
      begin
        try
          s1 := AContext.Connection.IOHandler.ReadString(7);
          laenge := StrToIntDef(s1, -1);
          log('Länge des Pakets: '+s1,0);
          if laenge>0 then
          begin
            s1 := AContext.Connection.IOHandler.ReadString(laenge);
            cli.anfrage := s1;
            Extrahiere_anfrage(cli.anfrage,s);
            if s<>'' then
            begin
              log('Anfrage: '+s,0);
              bearbeite_anfrage(s,cli);
            end;
          end
          else
          begin
            log('Längenangabe des zu empfangenden Buffers ist fehlerhaft ('+s1+')',1);
            fehler := TRUE;
          end;
        except
          on e :EIdConnClosedGracefully do
          begin
            log('ConnClosedGracefully',1);
            fehler := TRUE;
          end;
          on e :Exception do
          begin
            log('Fehler beim Lesen von Host='+cli.host+
                          ' Port='+IntToStr(cli.port),1);
            log(e.Message,9);
            log(e.ClassName,9);
            fehler := TRUE;
            disconnect(cli);
          end;
        end;
      end; // While
    end
    else
      log('Client nicht in Liste',1);
  except on e:exception do
    log('Feher in der Executeroutine des Servers: '+e.Message,9);
  end;
end;

Das OnDisconnect:

Delphi-Quellcode:

procedure TmyService.IdTCPServerDisconnect(AContext: TIdContext);
var
  Cli:TClient;
  i:integer;
  s:string;
begin
  // hier wird ein Client abgemeldet
  log('OnDisconnect: Client-List Size: '+IntToStr(client_list.Count),2);
  if AContext <> nil then begin
    Cli:= nil;
    s:= get_key(AContext);
    log('OnDisconnect des Clients: '+s,1);
    ThreadLock_ClientListe.Enter;
    try
       i:= client_list.IndexOf(s);
       log('OnDisconnect: Client-Index='+IntToStr(i),2);
       if (i > -1) then begin
          log('OnDisconnect: Index > -1 --> Disconnect aufrufen'+s,1);
          Cli:= TClient(client_list.objects[i]);
       end;
    finally
       ThreadLock_ClientListe.leave;
    end;
    if Cli <> nil then begin
       disconnect(Cli);
    end;
  end;
end;

Und zwei Methoden, die im OnExecute benutzt werden:

bearbeite_anfrage:

Delphi-Quellcode:

procedure TmyService.bearbeite_anfrage(var anfrage: String;
  cli: TClient);
var
  bearbeitet : boolean;
  msg : string;
begin
  // hier werden die von Clients eintreffenden Nachrichten bearbeitet
  log('Bearbeite Anfrage: '+cli.anfrage,2);
  bearbeitet := False;
  
  // hier die Nachrichten auswerten, z.B.
  if anfrage = schreibe_in_log then
  begin
    lies_nachricht(cli.anfrage, msg);
    log('WRITETOLOG: '+msg, 9);
    bearbeitet := True;
  end
  else if anfrage = disconnect_client then
  begin
    // disconnect des clients kommt gleich --> aus liste rausschmeißen
    disconnect(cli);
  end
  else
  begin
    log('Befehl '''+anfrage+''' nicht verstanden.',9);
  end;
  if bearbeitet then
    senden(cli,anfrage);
  anfrage:= '';
end;

Das Disconnect, welches aus bearbeite_anfrage, beim Eintreffen eines Disconnect-Kommandos aufgerufen wird:

Delphi-Quellcode:

procedure TmyServiceService.disconnect(cli: Tclient);
var
  i:integer;
begin
  (* Client wird aus der Liste entfernt und ein Disconnect durchgeführt *)
  try
    try
      ThreadLock_ClientListe.Enter;
      if client_list.Find(get_key(cli.Context),i) then
      begin
        log( 'Beende Verbindunge zu Host=' + cli.host+ ' Port=' + IntToStr(cli.Port)+' ....',1);
        // dem client mitteilen das jetzt die verbindung beendet wird
        senden(cli,disconnect_zeichen);
        cli.Context.Connection.DisconnectNotifyPeer;
        Tclient(client_list.Objects[i]).free;
        client_list.Delete(i);
        log('disconnect: Verbindung beendet',1);
      end;
    finally
      ThreadLock_ClientListe.Leave;
    end;
  except on e:exception do
       log('Fehler beim disconnect: '+e.Message,9);
  end;
end;