Indy TCPServer Freeze：Active => False

Question

我試圖找到爲什麼我的應用程序凍結時，我運行： IdTCPServer1.Active：= False;

當沒有客戶端連接時，沒有問題。 當一個或多個客戶端連接時，它會凍結。

如果有人能找到我犯了錯誤的地方。 （我是新來的Delphi，如果你看到別的東西錯了，或以錯誤的方式做......告訴我）

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; 

[編輯]

問題是與ListBoxClients在tsConnect和tsDisconnect中。 我正在尋找一種方法使它成爲ThreadSafe。

Answer 1

雷米Lebeau是對的！

我看到的代碼不是線程安全的，如tsConnect（） andtsDisconnect（）訪問ListBoxClients而不與 主UI線程同步。

我已經能夠解決我的問題與使用：

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); 

不知道這是否是正確的方式，但它的工作原理。