Delphi XE3, serveur TCP Indy. Arrêter le serveur

Question

J'ai adapté le code suivant d'un autre article sur ce site, mais il semble toujours se bloquer. Je dois être capable d'éteindre ou de déconnecter le serveur même s'il y a des clients connectés. Je vais attendre jusqu'à ce qu'ils finissent d'envoyer des messages, mais si je démarre le serveur, connectez-vous à partir d'un client, je ne peux toujours pas arrêter le serveur sans gel. Je dois ensuite éteindre avec Windows Task Manager.

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; 

informations Additonal ...

J'utilise le code suivant pour se connecter au serveur. Quand il se connecte le serveur renvoie un message qu'il y avait une connexion.

client Se connecter au serveur

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 sur le serveur

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; 

La combinaison de ces 2 procédures entraînera le serveur de geler lorsque je tente de fermer le programme serveur si je ne ferme pas bas le client d'abord. Je suis désolé, je suis trop nouveau pour Indy pour voir ce que le problème est ou comment faire le travail de thread pour résoudre le problème. J'espérais que vous verriez mon erreur débutants dans l'une des deux procédures de connexion.

Voici le code 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; 

Answer 1

Votre déclaration with appelle Contexts.LockList() et votre boucle appelle Contexts.LockList() à nouveau, mais vous n'appellent Contexts.UnlockList() une fois après la boucle terminée. En tant que tel, la liste Contexts est toujours verrouillée, et tout autre accès par d'autres threads se bloquera indéfiniment, y compris les threads clients lorsqu'ils essaieront de se retirer de la liste Contexts, ce qui à son tour bloquera le setter de la propriété Active car il attend tous les threads client à terminer.

Dans votre boucle, remplacez PantherIdTCPServer.Contexts.LockList.Count avec simplement Count depuis le with est agissant sur le TList que LockList() retourné:

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; 

En fait, tout le code que vous avez show est complètement redondante et doit être supprimée, c'est tout ce que vous avez besoin:

procedure TTasksForm.ShutDownPantherServer; 
begin 
    PantherIdTCPServer.Active := False; 
end; 

Il fait déjà tout le travail acharné de déconnecter les clients actifs, la compensation Contexts liste, et l'arrêt du serveur. Vous n'avez pas besoin de faire cela manuellement.