Indy TCPServer Freeze：アクティブ=>偽

Question

私が実行するとアプリケーションがフリーズする理由を見つけようとしています： IdTCPServer1.Active：= False;

クライアントが接続されていない場合は問題ありません。 1つ以上のクライアントが接続されている場合、クライアントはフリーズします。

誰かが私が間違っている場所を見つけることができる場合。 （私はあなたが間違った何かを見れば、デルファイへの新たなんだ、または間違った方法でそれをやって...私に教え）

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]

問題がListBoxClientsでありますtsConnectとtsDisconnectにあります。 私はそれをThreadSafeにする方法を探しています。

Answer 1

レミー・ルボーが正しくありました！

私は メインUIスレッドと同期せずにListBoxClientsにアクセスする（） andtsDisconnect（）などtsConnectなど、スレッドセーフでないコードを、見ています。

私が使用してと私の問題を解決することができました：それは正しい方法であれば

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; 

そして、私のtsConnectとtsDisconnect

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

を変更するには、知ってはいけません、それは動作します。