Delphi XE6 Indy Chat Room

Я пытаюсь сделать чат через Интернет с TIdTCP!
Когда клиент отправит сообщение на сервер, сервер продолжит отправку другим клиентам, вот мой код:

сервер

   var
  List: TIdContextList;
  Context: TIdContext;
  i: Integer;
  Msg: String;

Procedure TSForm.SendALL(text: string);
begin
  MSG:= Trim(text);
  List := Server.Contexts.LockList;
  try
    for i := 0 to List.Count - 1 do
    begin
      Context := TIDContext(List[i]);
      Context.Connection.IOHandler.WriteLn(UTF8Encode(msg));
    end;
  finally
    Server.Contexts.UnlockList;
  end;
end;

procedure TSForm.ServerExecute(AContext: TIdContext);
var m: string;
Begin
 m:= acontext.Connection.IOHandler.ReadLn();
  begin
   SForm.log.Lines.Add(Acontext.Connection.Socket.Binding.PeerIP+' > '+m); //Log is MEMO
   SendALL(m);
  end;
end;

И клиент

type
 TReadingThread = class(TThread)
  protected
    FConn: TIdTCPConnection;
    procedure Execute; override;
    procedure DoTerminate; override;
  public
    constructor Create(AConn: TIdTCPConnection); reintroduce;
  end;

var readthread: TReadingThread = Nil;

constructor TReadingThread.Create(AConn: TIdTCPConnection);
begin
  FConn := AConn;
  inherited Create(False);
end;

procedure TReadingThread.Execute;
var
  cmd: string;
begin
  while not Terminated do
  begin
    cmd := UTF8ToUnicodeString(FConn.IOHandler.ReadLn());
    Trim(cmd);
    if cmd <> '' then
    begin
    CForm.Memo1.Lines.Add(cmd); //Memo1 to show messages
    end;
  end;
   Application.ProcessMessages;
end;

procedure TReadingThread.DoTerminate;
begin
  inherited;
end;

procedure TCForm.ClientConnected(Sender: TObject);
begin
 readthread:= TReadingThread.Create(Client);
end;

procedure TCForm.ClientDisconnected(Sender: TObject);
begin
    if  readthread<> nil then
  begin
    readthread.Terminate;
    readthread.WaitFor;
    FreeAndNil(readthread);
  end;
end;

Все выглядит хорошо, но когда Сервер пересылает сообщения, другие клиенты получают его и обычно показывают в памятке, за исключением того, что Клиент, отправляющий это сообщение, кажется зависшим, должен щелкнуть по памятке, чтобы текст появился!

Я не знаю, что не так, надеюсь получить помощь от вас, спасибо!

1 ответ

Решение

В вашем коде есть две ошибки:

Вы получаете доступ к компонентам VCL из второго потока. Это обычно считается очень плохим, поскольку это может привести к множеству непредвиденных проблем.

procedure TReadingThread.Execute;
...
  CForm.Memo1.Lines.Add(cmd); //Verry bad as you are accesing VCL from another thread
...
  Application.ProcessMessages; //This is even worse. I suggest you get rid of this
...
end;

Также избавьтесь от Application.ProcessMessages, так как это может вызвать только больше проблем, которые он решает, не говоря уже о том, что это сильно влияет на производительность программ.

Поэтому вы должны использовать команду Синхронизировать при обновлении памятки. Это заставляет код для обновления памятки выполняться в основном потоке, как и весь код, который обращается к VCL.

procedure TReadingThread.Execute;
...
  Synchronize(
    procedure
    begin
      CForm.Memo1.Lines.Add(cmd);
    end;);
...
end;
Другие вопросы по тегам