客户端/服务器应用程序

时间：2019-10-27 15:48:26

标签： delphi indy

我正在编写一个客户端/服务器应用程序。一台服务器和几个客户端。

连接客户端时，任务是将其IP地址添加到列表框，而断开客户端连接时，将其从列表框中删除。然后在客户端和服务器之间交换消息。

出现了三个问题：当客户端连接时，其IP地址被添加到ListBox，但是当断开连接时，它不会从那里被删除，这是代码：

type
  TSimpleClient = class(TObject)
    DNS,
    Name        : String;
    ListLink    : Integer;
    Thread      : Pointer;
  end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient.Create;
  Client.DNS := AContext.Connection.Socket.Binding.PeerIP;
  Client.ListLink := ListBox1.Items.Count;
  Client.Thread := AContext;
  ListBox1.Items.Add(Client.DNS);
  AContext.Data := Client;
  Clients.Add(Client);
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
  sleep(2000);
  Client :=Pointer (AContext.Data);
  Clients.Delete(Client.ListLink);
  ListBox1.Items.Delete(ListBox1.Items.IndexOf(Client.DNS));
  Client.Free;
  AContext.Data := nil;
end;

第二个问题，当交换消息时，西里尔字母以“ ???”给出，所有Google都通过了它，因此找不到错误。

第三个问题，在客户端上是一个计时器，它侦听来自服务器的消息，当打开计时器时，客户端应用程序挂起，将所有这些放入流中也是同样的麻烦，代码如下： / p> 

if not IdTCPClient1.Connected then
  Exit;
s := IdTCPClient1.Socket.ReadLn;
if s <> '' then
  Label1.Text := s;

3 个答案:

答案 0 :(得分：3)

我发现您的代码有很多问题。

在服务器端，您需要摆脱TSimpleClient.ListLink字段。您正在滥用它，导致代码中的不良行为，因为在添加/删除客户端时不会保持更新。想想当您连接了2个客户端（其中ListLink分别为0和1，然后第一个客户端断开连接）时会发生什么。第二个客户端的ListLink无效，因为您没有将其从1减到0。

另外TIdTCPServer是一个多线程组件，它的事件在辅助线程的上下文中触发，但是事件处理程序代码不是线程安全的。从工作线程访问UI控件时，必须与主UI线程同步，并且必须保护Clients列表，防止跨线程边界的并发访问。在这种情况下，您实际上并不需要自己的Clients列表，因为TIdTCPServer拥有自己的线程安全Contexts列表，可用于访问连接的客户端。< / p>

您也根本不处理Unicode。默认情况下，Indy用于Unicode字符串的默认字节编码是US-ASCII，这就是为什么您为非ASCII字符获得?的原因。您可以使用IOHandler的DefStringEncoding属性设置不同的字节编码，例如IndyTextEncoding_UTF8（如果您使用的是Delphi 2007或更早版本，则可能还需要使用IOHandler的DefAnsiEncoding属性指定ANSI字符串与Unicode的相互转换方式。默认情况下，它设置为IndyTextEncoding_OSDefault。

尝试更多类似的方法：

type
  TSimpleClient = class(TObject)
    DNS,
    Name            : String;
    Thread          : Pointer;
    OutgoingMsgs    : TIdThreadSafeStringList;
    HasOutgoingMsgs : Boolean;

    constructor Create;
    destructor Destroy; override;

    procedure Queue(const Msg: string);
    procedure FlushMsgs;
  end;

constructor TSimpleClient.Create;
begin
  inherited;
  OutgoingMsgs := TIdThreadSafeStringList.Create;
end;

destructor TSimpleClient.Destroy;
begin
  OutgoingMsgs.Free;
  inherited;
end;

procedure TSimpleClient.Queue(const Msg: string);
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    List.Add(Msg);
    HasOutgoingMsgs := True;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TSimpleClient.FlushMsgs;
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    while List.Count > 0 do
    begin
      TIdContext(Thread).Connection.IOHandler.WriteLn(List[0]);
      List.Delete(0);
    end;
    HasOutgoingMsgs := False;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  Client: TSimpleClient;
begin
  PeerIP := AContext.Binding.PeerIP;

  Client := TSimpleClient.Create;
  Client.DNS := PeerIP;
  Client.Thread := AContext;
  AContext.Data := Client;

  TThread.Queue(nil,
    procedure
    begin
      ListBox1.Items.AddObject(PeerIP, Client);
    end
  );

  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
  Client := TSimpleClient(AContext.Data);
  try
    TThread.Queue(nil,
      procedure
      var
        Index: Integer;
      begin
        Index := ListBox1.Items.IndexOfObject(Client);
        if Index <> -1 then
          ListBox1.Items.Delete(Index);
      end;
    );
  finally
    { The anonymous procedure being passed to TThread.Queue() above captures
      the Client variable itself, not its value.  On ARC platforms, we need to
      prevent Free() setting the variable to nil before it can be passed to
      IndexOfObject(), and also because IndexOfObject() expects a live object
      anyway. ARC will free the object when the anonymous procedure exits. On
      non-ARC platforms, it is OK to Free() the object here, the variable will
      not change value, and IndexOfObject() does not need a live object... }
    {$IFNDEF AUTOREFCOUNT}
    Client.Free;
    {$ENDIF}
    AContext.Data := nil;
  end;
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient(AContext.Data);

  if Client.HasOutgoingMsgs then
    Client.FlushMsgs
  else
    Sleep(100);
end;

procedure TForm1.SendMessageToClient(Client: TSimpleClient; const Msg: string);
var
  List: TIdContextList;
begin
  List := IdTCPServer1.Contexts.LockList;
  try
    if List.IndexOf(TIdContext(Client.Thread)) <> -1 then // still connected?
      Client.Queue(Msg);
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Index: Integer;
  Msg: string;
  Client: TSimpleClient;
begin
  Index := ListBox1.ItemIndex;
  if Index = -1 then Exit;

  Msg := Edit1.Text;
  if Msg = '' then Exit;

  Client := TSimpleClient(ListBox1.Items.Objects[Index]);
  SendMessageToClient(Client, Msg);
end;

或者，您可以从TSimpleClient导出TIdServerContext并完全摆脱Thread字段：

type
  TSimpleClient = class(TIdServerContext)
    DNS,
    Name            : String;
    OutgoingMsgs    : TIdThreadSafeStringList;
    HasOutgoingMsgs : Boolean;

    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;

    procedure Queue(const Msg: string);
    procedure FlushMsgs;
  end;

constructor TSimpleClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited Create(AConnection, AYarn, AList);
  OutgoingMsgs := TIdThreadSafeStringList.Create;
end;

destructor TSimpleClient.Destroy;
begin
  OutgoingMsgs.Free;
  inherited;
end;

procedure TSimpleClient.Queue(const Msg: string);
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    List.Add(Msg);
    HasOutgoingMsgs := True;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TSimpleClient.FlushMsgs;
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    while List.Count > 0 do
    begin
      Self.Connection.IOHandler.WriteLn(List[0]);
      List.Delete(0);
    end;
    HasOutgoingMsgs := False;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTCPServer1.ContextClass := TSimpleClient;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  Client: TSimpleClient;
begin
  PeerIP := AContext.Binding.PeerIP;

  Client := TSimpleClient(AContext);
  Client.DNS := PeerIP;

  TThread.Queue(nil,
    procedure
    begin
      ListBox1.Items.AddObject(PeerIP, Client);
    end
  );

  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
  Client := TSimpleClient(AContext);

  TThread.Queue(nil,
    procedure
    var
      Index: Integer;
    begin
      Index := ListBox1.Items.IndexOfObject(Client);
      if Index <> -1 then
        ListBox1.Items.Delete(Index);
    end;
  );
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient(AContext);

  if Client.HasOutgoingMsgs then
    Client.FlushMsgs
  else
    Sleep(100);
end;

procedure TForm1.SendMessageToClient(Client: TSimpleClient; const Msg: string);
var
  List: TIdContextList;
begin
  List := IdTCPServer1.Contexts.LockList;
  try
    if List.IndexOf(TIdContext(Client)) <> -1 then // still connected?
      Client.Queue(Msg);
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Index: Integer;
  Msg: string;
  Client: TSimpleClient;
begin
  Index := ListBox1.ItemIndex;
  if Index = -1 then Exit;

  Msg := Edit1.Text;
  if Msg = '' then Exit;

  Client := TSimpleClient(ListBox1.Items.Objects[Index]);
  SendMessageToClient(Client, Msg);
end;

在客户端，您正在从主UI线程中的套接字读取数据，但是Indy使用阻塞套接字，因此其读取方法将阻塞调用线程，直到请求的数据到达为止。不要阻塞主UI线程！仅当实际上有可读取的内容时才读取，否则将读取结果移到单独的工作线程中。例如：

IdTCPClient1.Connect;
IdTCPClient1.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
...
IdTCPClient1.Disconnect;

...

procedure TForm1.Timer1Timer(Sender: TObject);
var
  s: string;
begin
  if IdTCPClient1.Connected and (not IdTCPClient1.IOHandler.InputBufferIsEmpty) then
  begin
    s := IdTCPClient1.IOHandler.ReadLn;
    if s <> '' then
      Label1.Text := s;
  end;
end;

或者：

type
  TReadingThread = class(TThread)
  protected
    procedure Execute; override;
  end;

procedure TReadingThread.Execute;
var
  s: String;
begin
  while not Terminated do
  begin
    s := Form1.IdTCPClient1.IOHandler.ReadLn;
    if s <> '' then
    begin
      TThread.Queue(nil,
        procedure
        begin
          Form1.Label1.Text := s;
        end
      );
    end;
  end;
end;

...

var
  ReadingThread: TReadingThread = nil;

...

IdTCPClient1.Connect;
IdTCPClient1.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
ReadingThread := TReadingThread.Create(False);
...
ReadingThread.Terminate;
try
  IdTCPClient1.Disconnect;
finally
  ReadingThread.WaitFor;
  ReadingThread.Free;
end;

答案 1 :(得分：0)

非常感谢Remy，您的回答确实帮助我解决了我的问题。我的目标是Windows和Android平台。我修复了一下代码，对我有用：

type
  TSimpleClient = class(TObject)
    DNS,
    Name            : String;
    Thread          : Pointer;
    OutgoingMsgs    : TIdThreadSafeStringList;
    HasOutgoingMsgs : Boolean;

    constructor Create;
    destructor Destroy; override;

    procedure Queue(const Msg: string);
    procedure FlushMsgs;
  end;

constructor TSimpleClient.Create;
begin
  inherited;
  OutgoingMsgs := TIdThreadSafeStringList.Create;
end;

destructor TSimpleClient.Destroy;
begin
  OutgoingMsgs.Free;
  inherited;
end;

procedure TSimpleClient.Queue(const Msg: string);
var
  List: TStringList;
  Client: TSimpleClient;
begin
  List := OutgoingMsgs.Lock;
  try
    List.Add(Msg);
    HasOutgoingMsgs := True;
    Client.FlushMsgs;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TSimpleClient.FlushMsgs;
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    while List.Count > 0 do
    begin
      TIdContext(Thread).Connection.IOHandler.WriteLn(List[0]);
      List.Delete(0);
    end;
    HasOutgoingMsgs := False;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  Client: TSimpleClient;
begin
  PeerIP := AContext.Binding.PeerIP;

  Client := TSimpleClient.Create;
  Client.DNS := PeerIP;
  Client.Thread := AContext;
  AContext.Data := Client;

  TThread.Queue(nil,
    procedure
    begin
      ListBox1.Items.AddObject(PeerIP, Client);
    end
  );

  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
  Client := TSimpleClient(AContext.Data);
  try
    TThread.Queue(nil,
      procedure
      var
        Index: Integer;
      begin
        Index := ListBox1.Items.IndexOfObject(Client);
        if Index <> -1 then
          ListBox1.Items.Delete(Index);
      end;
    );
  finally
    { The anonymous procedure being passed to TThread.Queue() above captures
      the Client variable itself, not its value.  On ARC platforms, we need to
      prevent Free() setting the variable to nil before it can be passed to
      IndexOfObject(), and also because IndexOfObject() expects a live object
      anyway. ARC will free the object when the anonymous procedure exits. On
      non-ARC platforms, it is OK to Free() the object here, the variable will
      not change value, and IndexOfObject() does not need a live object... }
    {$IFNDEF AUTOREFCOUNT}
    Client.Free;
    {$ENDIF}
    AContext.Data := nil;
  end;
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient(AContext.Data);

  if Client.HasOutgoingMsgs then
    Client.FlushMsgs
  else
    Sleep(100);
end;

procedure TForm1.SendMessageToClient(Client: TSimpleClient; const Msg: string);
var
  List: TIdContextList;
begin
  List := IdTCPServer1.Contexts.LockList;
  try
    if List.IndexOf(TIdContext(Client.Thread)) <> -1 then // still connected?
      Client.Queue(Msg);
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Index: Integer;
  Msg: string;
  Client: TSimpleClient;
begin
  Index := ListBox1.ItemIndex;
  if Index = -1 then Exit;

  Msg := Edit1.Text;
  if Msg = '' then Exit;

  Client := TSimpleClient(ListBox1.Items.Objects[Index]);
  SendMessageToClient(Client, Msg);
end;

我从TSimpleClient.Queue过程中添加了对FlushMsgs方法的调用，并开始发送消息，每次客户端连接和断开连接时客户端列表都会更新，并且服务器停止挂起。再次感谢雷米，金人，您为加快开发速度做出了很大的贡献。

答案 2 :(得分：-1)

谢谢雷米。字符编码的问题已解决，感谢您的解决方案。客户端冻结的问题已得到部分解决，现在服务器在发送消息时冻结，并且发送第一条消息时没有问题，当您单击“发送第二条消息”时，服务器死机了。而且，当客户端断开连接时，客户端也不会从列表框中删除。

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ScrollBox,
  FMX.Memo, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer,
  FMX.StdCtrls, FMX.Controls.Presentation, FMX.Edit, FMX.Layouts, FMX.ListBox,
  IdContext, IdThreadSafe, IDGlobal;

 type
  TSimpleClient = class(TObject)
    DNS,
    Name            : String;
    Thread          : Pointer;
    OutgoingMsgs    : TIdThreadSafeStringList;
    HasOutgoingMsgs : Boolean;

    constructor Create;
    destructor Destroy; override;

    procedure Queue(const Msg: string);
    procedure FlushMsgs;
  end;
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ListBox2: TListBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    IdTCPServer1: TIdTCPServer;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure IdTCPServer1Execute(AContext: TIdContext);
    procedure ListBox1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure SendMessageToClient(Client: TSimpleClient; const Msg: string);
  private
    { Private declarations }
  public
  Clients  : TList;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

constructor TSimpleClient.Create;
begin
  inherited;
  OutgoingMsgs := TIdThreadSafeStringList.Create;
end;

destructor TSimpleClient.Destroy;
begin
  OutgoingMsgs.Free;
  inherited;
end;

procedure TSimpleClient.Queue(const Msg: string);
begin
  with OutgoingMsgs.Lock do
  try
    Add(Msg);
    HasOutgoingMsgs := True;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TSimpleClient.FlushMsgs;
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    while List.Count > 0 do
    begin    TIdContext(Form1.IdTCPServer1.Contexts.LockList[0]).Connection.IOHandler.WriteLn(List[0]);
      List.Delete(0);
    end;
    HasOutgoingMsgs := False;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

//создаем сервер с указанным ip и портом
procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPServer1.Bindings.Add.IP:='127.0.0.1';
 IdTCPServer1.Bindings.Add.Port:=6000;
 try
    IdTCPServer1.Active:=true;
     except
    On E: Exception do
      Memo1.Lines.Add(E.Message);
  end;
end;
//закрываем соединение
procedure TForm1.Button2Click(Sender: TObject);
begin
IdTCPServer1.Active:=false;
end;
//отправляем команду
procedure TForm1.Button3Click(Sender: TObject);
var
  Index: Integer;
  Msg: string;
  Client: TSimpleClient;
begin
  Index := ListBox1.ItemIndex;
  if Index = -1 then Exit;

  Msg := Edit1.Text;
  if Msg = '' then Exit;

  Client := TSimpleClient(ListBox1.Items.Objects[Index]);
  SendMessageToClient(Client, Msg);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin

end;

procedure TForm1.Button5Click(Sender: TObject);
var s:string;
begin
s:=('Огонь!');
if ListBox2.Items.Count<1 then
ShowMessage('Некому отправлять')
else
IdTCPServer1.Contexts.UnlockList;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  Client: TSimpleClient;
begin
PeerIP := AContext.Binding.PeerIP;      //get ip adress connected client

  Client := TSimpleClient.Create;       //simple client
  Client.DNS := PeerIP;
  Client.Thread := AContext;            //get thread from context
  AContext.Data := Client;              //save client to data
  TThread.Queue(nil,
    procedure
    begin
      ListBox1.Items.AddObject(PeerIP, Client);  //add object client ip to ListBox
      end
  );
  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;  //encoding string
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
Client := TSimpleClient(AContext.Data);  //get client from a conext data
  try
    TThread.Queue(nil,
      procedure
      var
        Index: Integer;
      begin
        Index := ListBox1.Items.IndexOfObject(Client);    //assign index of object from listbox to index
        if Index <> -1 then         //if index not equal -1 then
          ListBox1.Items.Delete(Index);  //delete index
      end
      );
  finally
    Client.Free;
    AContext.Data := nil;
  end;
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient(AContext.Data);

  if Client.HasOutgoingMsgs then
    Client.FlushMsgs
  else
    Sleep(100);
end;

procedure TForm1.SendMessageToClient(Client: TSimpleClient; const Msg: string);
begin
  with IdTCPServer1.Contexts.LockList do
  try
    if IndexOf(TIdContext(Client.Thread)) <> -1 then // still connected?
      Client.Queue(Msg);
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
listBox2.Items.Add(ListBox1.Items[ListBox1.ItemIndex]);
end;

end.

在这里，我一点都不了解它是如何工作的，所以我在代码的开头添加了

。 
TIdContext(IdTCPServer1.Contexts.LockList[0]).Connection.IOHandler.WriteLn(s);

相反

Connection.IOHandler.WriteLn(List[0]);

客户停止了绞刑，开始应有的工作。再次感谢雷米的帮助和建议。

相关问题
最新问题