Indy TCPServer Freeze : Active => False

Question

실행할 때 응용 프로그램이 정지되는 이유를 찾으려고합니다. IdTCPServer1.Active : = False;

클라이언트가 연결되어 있지 않아도 문제가 없습니다. 하나 이상의 클라이언트가 연결되면 동결됩니다.

누군가 내가 실수 한 부분을 찾을 수 있다면. (I 말해 ... 당신이 뭔가 다른 잘못을 참조하면, 델파이에 새로 온 사람, 또는 잘못된 방법으로 그 일을)

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

레미 르 보우가 옳았습니다!

I는 메인 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); 

가 올바른 방법 인 경우

이 몰라 , 그러나 그것은 효과적이다.