Indy TCPServer Freeze: Active => False

Question

J'essaie de trouver pourquoi mon application se fige quand je cours: IdTCPServer1.Active: = False;

Lorsque aucun client n'est connecté, il n'y a pas de problème. Lorsqu'un client ou plus est connecté, il se bloque.

Si quelqu'un peut trouver où j'ai fait une erreur. (Je suis nouveau à Delphes, si vous voyez quelque chose d'autre mal, ou le faire dans le mauvais sens ... me dire)

TLog = class(TIdSync) 
     protected 
      FMsg: String; 
      procedure DoSynchronize; override; 
     public 
      constructor Create(const AMsg: String); 
      class procedure AddMsg(const AMsg: String); 
     end; 


procedure TLog.DoSynchronize; 
    begin 
    Form2.AddInfoDebugger('RECEPTION', FMsg); 
    end; 


class procedure TLog.AddMsg(const AMsg : String); 
    begin 
    with Create(AMsg) do 
     try 
     Synchronize; 
     finally 
     Free; 
     end; 
    end; 


constructor TLog.Create(const AMsg : String); 
    begin 
    FMsg := AMsg; 
    inherited Create; 
    end; 


    /// TFORM 2 /// 

constructor TForm2.Create(AOwner : TComponent); 
    begin 
    inherited Create(AOwner); 
    LoadIniConfiguration; 

    IdTCPServer1.ContextClass := TMyContext; 
    IdTCPServer1.DefaultPort := IndyServerPort; 
    DictionaryMessage := TDictionaryMessage.Create; 

    fSvrClose := False; 

    if fileexists(SaveFileName) 
    then 
     DictionaryMessage.LoadFromFile(SaveFileName); 
    UpdateListQuestions; 
    if IndyAutoStart 
    then 
     StartStopIndyServer; 

    // add info state debug save 
    if DebugConfigState 
    then 
     LabelStateDebugSave.Caption := 
     'Sauvegarde des journaux sur disque: Activé' 
    else 
     LabelStateDebugSave.Caption := 
     'Sauvegarde des journaux sur disque: Désactivé'; 

    end; 


procedure TForm2.FormClose(
    Sender  : TObject; 
    var action : TCloseAction); 
    var 
    iA : integer; 
    Context : TIdContext; 
    begin 
    if IdTCPServer1.Active 
    then 
    begin 
     fSvrClose := true; 
     IdTCPServer1.Active := False; 
     fSvrClose := False; 
    end; 

    end; 

// ****** 
// ******INDY procedures START*******// 
// ****** 


procedure TForm2.StartStopIndyServer; 
    begin 
    if not IdTCPServer1.Active 
    then 
    begin 
     IdTCPServer1.Active := true; 
     Form2.AddInfoDebugger('ONLINE', 
     'Server is now connected and ready to accept clients'); 
     ListBoxClients.Clear; 
     ListBoxClients.Items.Add('Serveur'); 
     UpdateCountClients; 
     Button1.Caption := 'Arret'; 
    end 
    else 
    begin 
     fSvrClose := true; 
     IdTCPServer1.Active := False; 
     fSvrClose := False; 
     ListBoxClients.Clear; 
     Form2.AddInfoDebugger('Offline', 'Server is now disconnected'); 
     Button1.Caption := 'Démarrer'; 
     UpdateCountClients; 
    end; 
    end; 


procedure TForm2.tsConnect(AContext : TIdContext); 
    begin 
    with TMyContext(AContext) do 
    begin 
     Con := Now; 
     if (Connection.Socket <> nil) 
     then 
     IP := Connection.Socket.Binding.PeerIP; 

     Nick := Connection.IOHandler.ReadLn; 
     if Nick <> '' 
     then 
     begin 
     Connection.IOHandler.WriteLn('Welcome ' + Nick + '!'); 
     ListBoxClients.Items.Add(Nick); 

     end 
     else 
     begin 
     Connection.IOHandler.WriteLn('No Nick provided! Goodbye.'); 
     Connection.Disconnect; 
     end; 
    end; 
    end; 


procedure TForm2.tsExecute(AContext : TIdContext); 
    var 
    FMsg, FMSG2, FMSG3, msg, str, toname, filename, cmd, from, 
     orsender : string; 
    FStream, fstream2 : TFileStream; 
    MStream : TMemoryStream; 
    idx, posi, col : integer; 
    Name1, Name2, Name3, MainStr : string; 
    RXStreamRichedit, DictionaryMessageStream : TStringStream; 
    LStreamSize : int64; 
    begin 
     //Empty for test// 
    end; 


procedure TForm2.tsDisconnect(AContext : TIdContext); 
    begin 
    AContext.Connection.Socket.InputBuffer.Clear; 
    AContext.Connection.Disconnect; 
    TLog.AddMsg(TMyContext(AContext).Nick + ' Left the chat'); 
    ListBoxClients.Items.Delete 
     (ListBoxClients.Items.IndexOf(TMyContext(AContext).Nick)); 
    end; 

[EDIT]

Le problème est avec ListBoxClients dans tsConnect et tsDisconnect. Je cherche un moyen de le rendre ThreadSafe.

Answer 1

Remy Lebeau avait raison!

Je ne vois code qui est thread-safe, comme TSconnect() andtsDisconnect() accès ListBoxClients sans synchronisation avec le fil de l'interface utilisateur principale .

Je suis en mesure de résoudre mon problème en utilisant:

TLog = class(TIdSync) 
    protected 
     FMsg : String; 
     procedure DoSynchronize; override; 
    public 
     constructor Create(const AMsg : String); 
     class procedure ProcessMsg(const AMsg : String); 
    end; 


procedure TLog.DoSynchronize; 
var 
posi: integer; 
MsgCommand, ContentCommand: string; 
    begin 
    posi := Pos('@', FMsg); 
    MsgCommand := Copy(FMsg, 1, posi - 1); 
    ContentCommand := Copy(FMsg, Pos('@', FMsg) + 1, Length(FMsg) - Pos('@', FMsg)); 

    if MsgCommand = 'AddListBox' then 
     Form2.ListBoxClients.items.Add(ContentCommand) 
    else if MsgCommand = 'DelListBox' then 
     Form2.ListBoxClients.Items.Delete(Form2.ListBoxClients.Items.IndexOf(ContentCommand)); 


    end; 


class procedure TLog.ProcessMsg(const AMsg : String); 
    begin 
    if not fSvrClose then 
    begin 
     with Create(AMsg) do 
     try 
      Synchronize; 
     finally 
      Free; 
     end; 
    end; 
    end; 


constructor TLog.Create(const AMsg : String); 
    begin 
    FMsg := AMsg; 
    inherited Create; 
    end; 

Et changer mon tsConnect et tsDisconnect

TLog.ProcessMsg('AddListBox@'+Nick); 

Je ne sais pas si elle est la bonne façon, mais ça marche.