Delphi Android App INDY TCP 服务器 - 应用程序在客户端断开连接后关闭
Delphi Android App INDY TCP Server - Application closes after client disconnect
我非常需要帮助。
我有一个基于 Indy 10 的 TIdTCPServer 组件的 TCP 服务器应用程序，我想在 Win32 和 Android 上 运行。我正在使用 Delphi XE7。
服务器必须处理 10 个客户端。
应用程序在 Windows 和 Android 上工作正常：连接、发送、接收数据，但 OnDisconnect 事件在 Android 而已。该应用程序在 Windows 上运行良好，但在 Android 上，断开客户端连接和事件 TCPServer.Active := FALSE 时存在大问题。在 90% 的情况下，当我断开客户端连接时，应用程序会自动关闭。
当我启动服务器时：TCPServer1.Active := TRUE，然后关闭它TCPServer1.Active := FALSE，没有连接客户端，应用程序工作正常。
我正在下面添加我的代码。我使用了 Remy Lebeau 的提示。
- 我正在用两个客户端测试应用程序。
- 我在 ListView 中显示连接的客户端。
- 我不是从服务器事件更新 ListView，而是在计时器事件中更新。
- 应用程序有 3 个按钮：服务器侦听、服务器关闭、发送（在 ListView 中选择的客户端数量）
请帮忙。
// TMyContext
constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
FQueue := TIdThreadSafeStringList.Create;
FEvent := TEvent.Create(nil, True, False, '');
end;
destructor TMyContext.Destroy;
begin
FQueue.Free;
FEvent.Free;
inherited;
end;
procedure TMyContext.AddMsgToQueue(const Msg: String);
begin
with FQueue.Lock do
try
Add(Msg);
FEvent.SetEvent;
finally
FQueue.Unlock;
end;
end;
function TMyContext.GetQueuedMsgs: TStrings;
var
List: TStringList;
begin
Result := nil;
if FEvent.WaitFor(1000) <> wrSignaled then Exit;
List := FQueue.Lock;
try
if List.Count > 0 then
begin
Result := TStringList.Create;
try
Result.Assign(List);
List.Clear;
except
Result.Free;
raise;
end;
end;
FEvent.ResetEvent;
finally
FQueue.Unlock;
end;
end;
// TCPServer
procedure THeaderFooterwithNavigation.TCPServer1Connect(AContext: TIdContext);
var
client : String;
datetime : TDateTime;
begin
datetime := now;
// CLIENT CON INFO
client := AContext.Binding.PeerIP;
TThread.Queue(nil,
procedure
begin
TCPServer1.Contexts.LockList();
mmoLog.Lines.Add ('CONNECT: ' + AContext.Connection.Socket.Binding.PeerIP
+ ' : ' +
IntToStr(AContext.Connection.Socket.Binding.PeerPort) + ' ' +
DateToStr (datetime) + ' ' + TimeToStr (datetime)
);
TCPServer1.Contexts.UnlockList();
if TCPServer1.Contexts.Count = 1 then
edtPort1.Text := IntToStr(AContext.Connection.Socket.Binding.PeerPort);
if TCPServer1.Contexts.Count = 2 then
edtPort2.Text := IntToStr(AContext.Connection.Socket.Binding.PeerPort);
AContext.Connection.Socket.Binding.Send('HELLO');
// CLIENTSDATA LIST
ClientsList.Add (' ', AContext.Connection.Socket.Binding.PeerIP, AContext.Connection.Socket.Binding.PeerPort);
LV_Refresh ();
end
);
end;
procedure THeaderFooterwithNavigation.TCPServer1Disconnect(
AContext: TIdContext);
var
cl_item : Integer;
datetime : TDateTime;
begin
try
datetime := now;
if fSvrClose = FALSE then begin
fClDiscon := TRUE;
buff_discon [pos_ip] := AContext.Connection.Socket.Binding.PeerIP;
buff_discon [pos_port] := IntToStr (AContext.Connection.Socket.Binding.PeerPort);
buff_discon [pos_date] := DateToStr (datetime);
buff_discon [pos_time] := TimeToStr (datetime);
end;
finally
AContext.Connection.Socket.InputBuffer.Clear;
AContext.Connection.Disconnect;
end;
end;
procedure THeaderFooterwithNavigation.TCPServer1Exception(AContext: TIdContext;
AException: Exception);
begin
ShowMessage ('Error');
end;
procedure THeaderFooterwithNavigation.TCPServer1Execute(AContext: TIdContext);
var
buff : String;
List : TStrings;
I : Integer;
buffout : String;
n : Integer;
// FOR DISCONNECT
{$IFDEF MSWINDOWS}
clist : TList;
{$ENDIF MSWINDOWS}
{$IFDEF Android}
clist : TList <TIdContext>;
{$ENDIF Android}
begin
if fSvrClose = FALSE then begin
// READ MESSAGES FROM THE CLIENTS
fDisconAccess := FALSE;
// SEND MESSAGES TO THE CLIENTS
List := TMyContext(AContext).GetQueuedMsgs;
if List <> nil then begin
try
for I := 0 to List.Count-1 do
AContext.Connection.IOHandler.Write(List[I]);
finally
List.Free;
end;
end;
// READ MESSAGE FROM CLIENTS
if AContext.Connection.IOHandler.CheckForDataOnSource(200) then begin
buffout := AContext.Connection.IOHandler.ReadLn();
TThread.Queue(nil,
procedure
begin
if AContext.Connection.Socket.Binding.PeerPort = StrToInt(edtPort1.Text) then begin
edtRec1.Text := buffout;
end;
if AContext.Connection.Socket.Binding.PeerPort = StrToInt(edtPort2.Text) then begin
edtRec2.Text := buffout;
end;
end
);
end;
fDisconAccess := TRUE;
end;
end;
// USER INTERFACE
procedure THeaderFooterwithNavigation.SendMessage (const IP : String; port : Word; Msg: string);
var
I: Integer;
begin
with TCPServer1.Contexts.LockList do
try
for I := 0 to Count-1 do begin
with TMyContext(Items[I]) do begin
if (Binding.PeerIP = IP) and (Binding.PeerPort = port) then begin
AddMsgToQueue(Msg);
Break;
end;
end;
end;
finally
TCPServer1.Contexts.UnlockList;
end;
end;
procedure THeaderFooterwithNavigation.Timer1Timer(Sender: TObject);
begin
Get_ClientsNum ();
// UPDATE UI (USER INTERFACE)
UpdateUI ();
// BUTTONS
if TCPServer1.Active = TRUE then begin
btnListen.Enabled := FALSE;
edtStatus.Text := 'LISTENING';
end else begin
btnListen.Enabled := TRUE;
edtStatus.Text := 'CLOSED';
end;
// ON SINGLE CLIENT DISCONNECT
if fClDiscon = TRUE then begin
fClDiscon := FALSE;
CL_DeleteClient (buff_discon [pos_ip], StrToInt (buff_discon [pos_port]));
LV_Refresh ();
mmoLog.Lines.Add ('DISCON: ' + buff_discon [pos_ip] + ' : ' + buff_discon [pos_port] + ' ' +
buff_discon [pos_date] + ' ' + buff_discon [pos_time] );
end;
end;
procedure THeaderFooterwithNavigation.TitleActionUpdate(Sender: TObject);
begin
if Sender is TCustomAction then
begin
if TabControl1.ActiveTab <> nil then
TCustomAction(Sender).Text := TabControl1.ActiveTab.Text
else
TCustomAction(Sender).Text := '';
end;
end;
procedure THeaderFooterwithNavigation.btnCloseClick(Sender: TObject);
var
{$IFDEF MSWINDOWS}
clist : TList;
{$ENDIF MSWINDOWS}
{$IFDEF Android}
clist : TList <TIdContext>;
{$ENDIF Android}
i : Integer;
ip : String;
port : Word;
datetime : TDateTime;
begin
TThread.Queue(nil,
procedure
var
n : Integer;
begin
datetime := now;
if Clients_Num = 0 then begin
TCPServer1.StopListening();
TCPServer1.Active := FALSE;
end else begin
fSvrClose := TRUE;
// SERVER CLOSE
if fSvrClose = TRUE then begin
while fDisconAccess = FALSE do begin
end;
try
clist := TCPServer1.Contexts.LockList;
for n := 0 to (clist.Count - 1) do begin
try
TIdContext (clist[n]).Connection.Socket.WriteBufferClear;
TIdContext (clist[n]).Connection.Socket.InputBuffer.Clear;
ip := TIdContext (clist[n]).Connection.Socket.Binding.PeerIP;
port := TIdContext (clist[n]).Connection.Socket.Binding.PeerPort;
TIdContext (clist[n]).Connection.Disconnect;
CL_DeleteClient (ip, port);
mmoLog.Lines.Add ('DISCON: ' + ip + ' : ' + IntToStr(port) + ' ' +
DateToStr (datetime) + ' ' + TimeToStr (datetime) );
sleep (100);
except
end;
end;
finally
TCPServer1.Contexts.UnlockList;
TCPServer1.Active := FALSE;
fSvrClose := FALSE;
LV_Refresh ();
end;
end;
end
);
end;
procedure THeaderFooterwithNavigation.btnListenClick(Sender: TObject);
var
port : Word;
begin
port := StrToInt (edtPort.Text);
TCPServer1.Contexts.Clear;
TCPServer1.Bindings.Clear();
if (port > 200) and (port < 65535) then begin
TCPServer1.DefaultPort := StrToInt (edtPort.Text);
end else
TCPServer1.DefaultPort := 30000;
TCPServer1.Bindings.Add.IPVersion := Id_IPv4;
if TCPServer1.Active = FALSE then begin
TCPServer1.Active := TRUE;
end;
end;
procedure THeaderFooterwithNavigation.btnSendClick(Sender: TObject);
var
ip : string;
port : Word;
item : Integer;
begin
item := LV.ItemIndex;
if (item > -1) then begin
ip := ClientsList.Items[item].IP;
port := ClientsList.Items[item].Port;
SendMessage (ip, port, edtSend.Text);
end;
end;
procedure THeaderFooterwithNavigation.Get_ClientsNum ();
var
{$IFDEF MSWINDOWS}
clist : TList;
{$ENDIF MSWINDOWS}
{$IFDEF Android}
clist : TList <TIdContext>;
{$ENDIF Android}
begin
try
clist := TCPServer1.Contexts.LockList();
Clients_Num := TCPServer1.Contexts.Count;
finally
TCPServer1.Contexts.UnlockList;
end;
end;
对于 Windows 或 Android，此代码不正确或不安全。它能奏效，纯属运气。这段代码中有很多危险的逻辑需要重写。
尝试更像这样的东西：
// TMyContext
constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
FQueue := TIdThreadSafeStringList.Create;
FEvent := TEvent.Create(nil, True, False, '');
end;
destructor TMyContext.Destroy;
begin
FQueue.Free;
FEvent.Free;
inherited;
end;
procedure TMyContext.AddMsgToQueue(const Msg: String);
begin
with FQueue.Lock do
try
Add(Msg);
FEvent.SetEvent;
finally
FQueue.Unlock;
end;
end;
function TMyContext.GetQueuedMsgs: TStrings;
var
List: TStringList;
begin
Result := nil;
if FEvent.WaitFor(1000) <> wrSignaled then Exit;
List := FQueue.Lock;
try
if List.Count > 0 then
begin
Result := TStringList.Create;
try
Result.Assign(List);
List.Clear;
except
Result.Free;
raise;
end;
end;
FEvent.ResetEvent;
finally
FQueue.Unlock;
end;
end;
// TCPServer
procedure THeaderFooterwithNavigation.LogMessage(Msg: string);
begin
TThread.Queue(nil,
procedure
begin
mmoLog.Lines.Add (Msg);
end
);
end;
procedure THeaderFooterwithNavigation.TCPServer1Connect(AContext: TIdContext);
var
clientIP : String;
clientPort: TIdPort;
datetime : TDateTime;
begin
datetime := now;
// CLIENT CON INFO
clientIP := AContext.Binding.PeerIP;
clientPort := AContext.Binding.PeerPort;
AContext.Connection.IOHandler.WriteLn('HELLO');
LogMessage('CONNECT: ' + clientIP + ' : ' + IntToStr(clientPort) + ' ' + DateToStr (datetime) + ' ' + TimeToStr (datetime));
TThread.Queue(nil,
procedure
var
client: string;
begin
client := clientIP + ':' + IntToStr(clientPort);
case TCPServer1.Contexts.Count of
1: edtPort1.Text := client;
2: edtPort2.Text := client;
end;
// CLIENTSDATA LIST
ClientsList.Add (' ', clientIP, clientPort);
LV_Refresh;
end
);
end;
procedure THeaderFooterwithNavigation.TCPServer1Disconnect(
AContext: TIdContext);
var
datetime : TDateTime;
clientIP : String;
clientPort: TIdPort;
begin
datetime := now;
// CLIENT CON INFO
clientIP := AContext.Binding.PeerIP;
clientPort := AContext.Binding.PeerPort;
LogMessage('DISCON: ' + clientIP + ' : ' + IntToStr(clientPort) + ' ' + DateToStr(datetime) + ' ' + TimeToStr(datetime));
TThread.Queue(nil,
procedure
var
client: string;
begin
client := clientIP + ':' + IntToStr(clientPort);
if edtPort1.Text = client then begin
edtPort1.Text := '';
end;
if edtPort2.Text = client then begin
edtPort2.Text := '';
end;
CL_DeleteClient (clientIP, clientPort);
if fSvrClose = FALSE then LV_Refresh;
end
);
end;
procedure THeaderFooterwithNavigation.TCPServer1Exception(AContext: TIdContext; AException: Exception);
begin
if fSvrClose = FALSE then
LogMessage ('Error: ' + AException.Message);
end;
procedure THeaderFooterwithNavigation.TCPServer1Execute(AContext: TIdContext);
var
buff : String;
List : TStrings;
I : Integer;
clientIP: String;
clientPort: TIdPort;
begin
if fSvrClose = TRUE then Exit;
// SEND MESSAGES TO THE CLIENTS
List := TMyContext(AContext).GetQueuedMsgs;
if List <> nil then
try
for I := 0 to List.Count-1 do
AContext.Connection.IOHandler.WriteLn(List[I]);
finally
List.Free;
end;
if fSvrClose = TRUE then Exit;
// READ MESSAGE FROM CLIENTS
if AContext.Connection.IOHandler.InputBufferIsEmpty then begin
AContext.Connection.IOHandler.CheckForDataOnSource(200);
AContext.Connection.IOHandler.CheckForDisconnect;
if fSvrClose = TRUE then Exit;
end;
if not AContext.Connection.IOHandler.InputBufferIsEmpty then begin
begin
buff := AContext.Connection.IOHandler.ReadLn;
if fSvrClose = TRUE then Exit;
clientIP := AContext.Binding.PeerIP;
clientPort := AContext.Binding.PeerPort;
TThread.Queue(nil,
procedure
var
client: string;
begin
client := clientIP + ':' + IntToStr(clientPort);
if edtPort1.Text = client then begin
edtRec1.Text := buff;
end;
if edtPort2.Text = client then begin
edtRec2.Text := buff;
end;
end
);
end;
end;
// USER INTERFACE
procedure THeaderFooterwithNavigation.SendMessage (const IP : String; port : TIdPort; const Msg: string);
var
I: Integer;
begin
with TCPServer1.Contexts.LockList do
try
for I := 0 to Count-1 do begin
with TMyContext(Items[I]) do begin
if (Binding <> nil) and (Binding.PeerIP = IP) and (Binding.PeerPort = port) then begin
AddMsgToQueue(Msg);
Exit;
end;
end;
end;
finally
TCPServer1.Contexts.UnlockList;
end;
end;
procedure THeaderFooterwithNavigation.Timer1Timer(Sender: TObject);
begin
Get_ClientsNum;
// UPDATE UI (USER INTERFACE)
UpdateUI;
end;
procedure THeaderFooterwithNavigation.TitleActionUpdate(Sender: TObject);
begin
if Sender is TCustomAction then
begin
if TabControl1.ActiveTab <> nil then
TCustomAction(Sender).Text := TabControl1.ActiveTab.Text
else
TCustomAction(Sender).Text := '';
end;
end;
procedure THeaderFooterwithNavigation.btnCloseClick(Sender: TObject);
begin
fSvrClose := TRUE;
// SERVER CLOSE
TCPServer1.Active := FALSE;
btnListen.Enabled := TRUE;
edtStatus.Text := 'CLOSED';
fSvrClose := FALSE;
LV_Refresh;
end;
procedure THeaderFooterwithNavigation.btnListenClick(Sender: TObject);
var
port : TIdPort;
begin
port := StrToInt (edtPort.Text);
TCPServer1.Active := False;
TCPServer1.Bindings.Clear;
if (port > 200) and (port < 65535) then begin
TCPServer1.DefaultPort := port;
end else
TCPServer1.DefaultPort := 30000;
TCPServer1.Bindings.Add.IPVersion := Id_IPv4;
TCPServer1.Active := TRUE;
btnListen.Enabled := FALSE;
edtStatus.Text := 'LISTENING';
end;
procedure THeaderFooterwithNavigation.btnSendClick(Sender: TObject);
var
ip : string;
port : Word;
item : Integer;
begin
item := LV.ItemIndex;
if (item > -1) then begin
ip := ClientsList.Items[item].IP;
port := ClientsList.Items[item].Port;
SendMessage (ip, port, edtSend.Text);
end;
end;
procedure THeaderFooterwithNavigation.Get_ClientsNum;
begin
Clients_Num := TCPServer1.Contexts.Count;
end;
几乎每次断开 client/clients 和停用服务器时都会出现此问题。 disconnect/deactivate 事件进展顺利的情况是有的，但只有当一个客户端连接时。当连接的客户端很少时，断开连接和停用事件总是出错。我已经测试了我的应用程序，即使所有 UI 功能都被禁用并且没有任何改进。
我的应用程序运行平稳稳定的唯一情况是在我手机上的 Android 5.0 Lollipop API 21 上。我可以一个接一个地断开所有客户端，我可以停用连接客户端的服务器，即使启用 UI 功能，一切也能正常工作。
也许在 Jelly Bean 或 Delphi 等旧版本的 Android 上需要进行一些系统配置？很遗憾我的平板无法升级到API 5.0.
确切地说，我将向您展示 UI 函数：
（我正在制作自己的 ClientsList，因为我必须记住更多数据，例如设备名称或序列号。使用我自己的代码更容易。）
<code>
// ----------------------------------------------------------------- LIST VIEW
procedure THeaderFooterwithNavigation.LV_MakeLine;
var
Item : TListItem;
begin
Item := LV.Items.Add;
end;
procedure THeaderFooterwithNavigation.LV_AddData (index : Word);
var
Item : TListItem;
Client : TClientTcp;
ip : String;
port : String;
name : String;
begin
Client := ClientsList.Items [index];
Item := LV.Items.Item [index];
LV.Items.Item [index].Text := Client.Name + ' ' + Client.IP + ' : ' + IntToStr(Client.Port);
end;
procedure THeaderFooterwithNavigation.LV_Refresh;
var
i : Integer;
itms : Integer;
begin
LV.Items.Clear;
//LV.ClearItems;
itms := ClientsList.Count;
for i := 0 to itms-1 do begin
LV_MakeLine ();
LV_AddData (i);
end;
end;
procedure THeaderFooterwithNavigation.CL_DeleteClient (ip : String; port : Word);
var
cl_item : Integer;
begin
cl_item := ClientsList.FindClient_ByIpPort (ip, port);
if cl_item > (-1) then begin
// DELETE DISCONNECTED CLIENT FROM LIST AND SET LIST SIZE TO THE CLIENTS NUMBER
ClientsList.Delete (cl_item);
end;
end;
</p>
<p>和客户名单</p>
<pre>unit ServerTcpA;
interface
{
uses
SysUtils, Variants, Classes, Generics.Collections;
}
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
System.Generics.Collections;
{
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Contnrs, ComCtrls,
Buttons, WinSock, ScktComp;
}
type
// CLASS DECLARATIONS ----------------------------------------------------
// TClientTcp CLASS -----------------------------------------------------
TClientTcp = class (TObject)
public
Name : String;
IP : String;
Port : Integer;
RecFrames : Integer;
end;
// TClientsTcpList CLASS -------------------------------------------------
TClientsTcpList = class (TObjectList <TObject>)
private
function FGetItem (index : Integer) : TClientTcp;
public
property Items [index : Integer] : TClientTcp read FGetItem;
function Add (name : String; ip : String; port: Integer) : TClientTcp;
function FindClient_ByName (name : String) : TClientTcp;
function FindClient_ByIp (ip : String) : TClientTcp;
function FindClient_ByPort (port : Integer) : Integer;
function FindClient_ByIpPort (ip : String; port : Integer): Integer;
end;
// TTcpCfg CLASS ---------------------------------------------------------
TTcpCfg = class (TObject)
TcpClientsList : TClientsTcpList;
public
constructor Create;
destructor Destroy; override;
function AddClient (ip : String; port: Integer) : TClientTcp;
end;
// ENUM - Defined Column Names -------------------------------------------
type TColNames = (
COL_LP = 0,
COL_NAME,
COL_IP,
COL_PORT
);
const
NONE = -1;
var
//ServerTcpDK : TServerSocket;
//TCPCFG : TTcpCfg;
ClientsList : TClientsTcpList;
implementation
// =================================================== CLASS: TClientsTcpList
// GET ITEM
function TClientsTcpList.FGetItem (index : Integer) : TClientTcp;
begin
//Result := inherited GetItem (index) as TClientTcp;
Result := inherited Items [index] as TClientTcp;
end;
// ADD ITEM
function TClientsTcpList.Add (name : String; ip : String; port: Integer) : TClientTcp;
begin
if (FindClient_ByIpPort (ip, port) = NONE) then begin
Result := TClientTcp.Create;
Result.Name := name;
Result.IP := ip;
Result.Port := port;
Result.RecFrames := 0;
inherited Add (Result);
end;
end;
// FIND CLIENT: BY NAME
function TClientsTcpList.FindClient_ByName (name : String): TClientTcp;
var
i : integer;
begin
//Result := nil;
Result := nil;
for i:=0 to Count-1 do begin
if Items [i].Name = name then begin
Result := Items[i];
break;
end;
end;
end;
// FIND CLIENT: BY IP
function TClientsTcpList.FindClient_ByIp (ip : String): TClientTcp;
var
i : integer;
begin
//Result := nil;
Result := nil;
for i:=0 to Count-1 do begin
if Items [i].IP = ip then begin
Result := Items[i];
break;
end;
end;
end;
// FIND CLIENT: BY PORT ------------------------------------------------------
// @Ret: Item Index in the LIST
// -1: Not Found
function TClientsTcpList.FindClient_ByPort (port : Integer): Integer;
var
i : integer;
begin
Result := NONE;
for i:=0 to Count-1 do begin
if Items [i].Port = port then begin
Result := i;
break;
end;
end;
end;
// FIND CLIENT: BY IP AND PORT -----------------------------------------------
// @Ret: Item Index in the LIST
// -1: Not Found
function TClientsTcpList.FindClient_ByIpPort (ip : String; port : Integer): Integer;
var
i : integer;
begin
Result := NONE;
for i:=0 to Count-1 do begin
if (Items [i].IP = ip) and (Items [i].Port = port) then begin
Result := i;
break;
end;
end;
end;
// =========================================================== CLASS: TTcpCfg
constructor TTcpCfg.Create;
begin
inherited;
TcpClientsList := TClientsTcpList.Create;
end;
destructor TTcpCfg.Destroy;
begin
TcpClientsList.Free;
inherited;
end;
function TTcpCfg.AddClient (ip : String; port: Integer) : TClientTcp;
begin
Result := TClientTcp.Create;
//TcpClientsList.Add (Result);
Result.IP := ip;
Result.Port := port;
Result.RecFrames := 0;
end;
// ============================================================ INITIALIZATION
initialization
//ServerTcpDK := TServerSocket.Create (Nil);
//TCPCFG := TTcpCfg.Create;
ClientsList := TClientsTcpList.Create;
finalization
//ServerTcpDK.Free;
//TCPCFG.Free;
ClientsList.Free;
// @END OF FILE --------------------------------------------------------------
end.
我非常需要帮助。
我有一个基于 Indy 10 的 TIdTCPServer 组件的 TCP 服务器应用程序，我想在 Win32 和 Android 上 运行。我正在使用 Delphi XE7。
服务器必须处理 10 个客户端。
应用程序在 Windows 和 Android 上工作正常：连接、发送、接收数据，但
OnDisconnect事件在 Android 而已。该应用程序在 Windows 上运行良好，但在 Android 上，断开客户端连接和事件TCPServer.Active := FALSE时存在大问题。在 90% 的情况下，当我断开客户端连接时，应用程序会自动关闭。当我启动服务器时：
TCPServer1.Active := TRUE，然后关闭它TCPServer1.Active := FALSE，没有连接客户端，应用程序工作正常。
我正在下面添加我的代码。我使用了 Remy Lebeau 的提示。
- 我正在用两个客户端测试应用程序。
- 我在 ListView 中显示连接的客户端。
- 我不是从服务器事件更新 ListView，而是在计时器事件中更新。
- 应用程序有 3 个按钮：服务器侦听、服务器关闭、发送（在 ListView 中选择的客户端数量）
请帮忙。
// TMyContext
constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
FQueue := TIdThreadSafeStringList.Create;
FEvent := TEvent.Create(nil, True, False, '');
end;
destructor TMyContext.Destroy;
begin
FQueue.Free;
FEvent.Free;
inherited;
end;
procedure TMyContext.AddMsgToQueue(const Msg: String);
begin
with FQueue.Lock do
try
Add(Msg);
FEvent.SetEvent;
finally
FQueue.Unlock;
end;
end;
function TMyContext.GetQueuedMsgs: TStrings;
var
List: TStringList;
begin
Result := nil;
if FEvent.WaitFor(1000) <> wrSignaled then Exit;
List := FQueue.Lock;
try
if List.Count > 0 then
begin
Result := TStringList.Create;
try
Result.Assign(List);
List.Clear;
except
Result.Free;
raise;
end;
end;
FEvent.ResetEvent;
finally
FQueue.Unlock;
end;
end;
// TCPServer
procedure THeaderFooterwithNavigation.TCPServer1Connect(AContext: TIdContext);
var
client : String;
datetime : TDateTime;
begin
datetime := now;
// CLIENT CON INFO
client := AContext.Binding.PeerIP;
TThread.Queue(nil,
procedure
begin
TCPServer1.Contexts.LockList();
mmoLog.Lines.Add ('CONNECT: ' + AContext.Connection.Socket.Binding.PeerIP
+ ' : ' +
IntToStr(AContext.Connection.Socket.Binding.PeerPort) + ' ' +
DateToStr (datetime) + ' ' + TimeToStr (datetime)
);
TCPServer1.Contexts.UnlockList();
if TCPServer1.Contexts.Count = 1 then
edtPort1.Text := IntToStr(AContext.Connection.Socket.Binding.PeerPort);
if TCPServer1.Contexts.Count = 2 then
edtPort2.Text := IntToStr(AContext.Connection.Socket.Binding.PeerPort);
AContext.Connection.Socket.Binding.Send('HELLO');
// CLIENTSDATA LIST
ClientsList.Add (' ', AContext.Connection.Socket.Binding.PeerIP, AContext.Connection.Socket.Binding.PeerPort);
LV_Refresh ();
end
);
end;
procedure THeaderFooterwithNavigation.TCPServer1Disconnect(
AContext: TIdContext);
var
cl_item : Integer;
datetime : TDateTime;
begin
try
datetime := now;
if fSvrClose = FALSE then begin
fClDiscon := TRUE;
buff_discon [pos_ip] := AContext.Connection.Socket.Binding.PeerIP;
buff_discon [pos_port] := IntToStr (AContext.Connection.Socket.Binding.PeerPort);
buff_discon [pos_date] := DateToStr (datetime);
buff_discon [pos_time] := TimeToStr (datetime);
end;
finally
AContext.Connection.Socket.InputBuffer.Clear;
AContext.Connection.Disconnect;
end;
end;
procedure THeaderFooterwithNavigation.TCPServer1Exception(AContext: TIdContext;
AException: Exception);
begin
ShowMessage ('Error');
end;
procedure THeaderFooterwithNavigation.TCPServer1Execute(AContext: TIdContext);
var
buff : String;
List : TStrings;
I : Integer;
buffout : String;
n : Integer;
// FOR DISCONNECT
{$IFDEF MSWINDOWS}
clist : TList;
{$ENDIF MSWINDOWS}
{$IFDEF Android}
clist : TList <TIdContext>;
{$ENDIF Android}
begin
if fSvrClose = FALSE then begin
// READ MESSAGES FROM THE CLIENTS
fDisconAccess := FALSE;
// SEND MESSAGES TO THE CLIENTS
List := TMyContext(AContext).GetQueuedMsgs;
if List <> nil then begin
try
for I := 0 to List.Count-1 do
AContext.Connection.IOHandler.Write(List[I]);
finally
List.Free;
end;
end;
// READ MESSAGE FROM CLIENTS
if AContext.Connection.IOHandler.CheckForDataOnSource(200) then begin
buffout := AContext.Connection.IOHandler.ReadLn();
TThread.Queue(nil,
procedure
begin
if AContext.Connection.Socket.Binding.PeerPort = StrToInt(edtPort1.Text) then begin
edtRec1.Text := buffout;
end;
if AContext.Connection.Socket.Binding.PeerPort = StrToInt(edtPort2.Text) then begin
edtRec2.Text := buffout;
end;
end
);
end;
fDisconAccess := TRUE;
end;
end;
// USER INTERFACE
procedure THeaderFooterwithNavigation.SendMessage (const IP : String; port : Word; Msg: string);
var
I: Integer;
begin
with TCPServer1.Contexts.LockList do
try
for I := 0 to Count-1 do begin
with TMyContext(Items[I]) do begin
if (Binding.PeerIP = IP) and (Binding.PeerPort = port) then begin
AddMsgToQueue(Msg);
Break;
end;
end;
end;
finally
TCPServer1.Contexts.UnlockList;
end;
end;
procedure THeaderFooterwithNavigation.Timer1Timer(Sender: TObject);
begin
Get_ClientsNum ();
// UPDATE UI (USER INTERFACE)
UpdateUI ();
// BUTTONS
if TCPServer1.Active = TRUE then begin
btnListen.Enabled := FALSE;
edtStatus.Text := 'LISTENING';
end else begin
btnListen.Enabled := TRUE;
edtStatus.Text := 'CLOSED';
end;
// ON SINGLE CLIENT DISCONNECT
if fClDiscon = TRUE then begin
fClDiscon := FALSE;
CL_DeleteClient (buff_discon [pos_ip], StrToInt (buff_discon [pos_port]));
LV_Refresh ();
mmoLog.Lines.Add ('DISCON: ' + buff_discon [pos_ip] + ' : ' + buff_discon [pos_port] + ' ' +
buff_discon [pos_date] + ' ' + buff_discon [pos_time] );
end;
end;
procedure THeaderFooterwithNavigation.TitleActionUpdate(Sender: TObject);
begin
if Sender is TCustomAction then
begin
if TabControl1.ActiveTab <> nil then
TCustomAction(Sender).Text := TabControl1.ActiveTab.Text
else
TCustomAction(Sender).Text := '';
end;
end;
procedure THeaderFooterwithNavigation.btnCloseClick(Sender: TObject);
var
{$IFDEF MSWINDOWS}
clist : TList;
{$ENDIF MSWINDOWS}
{$IFDEF Android}
clist : TList <TIdContext>;
{$ENDIF Android}
i : Integer;
ip : String;
port : Word;
datetime : TDateTime;
begin
TThread.Queue(nil,
procedure
var
n : Integer;
begin
datetime := now;
if Clients_Num = 0 then begin
TCPServer1.StopListening();
TCPServer1.Active := FALSE;
end else begin
fSvrClose := TRUE;
// SERVER CLOSE
if fSvrClose = TRUE then begin
while fDisconAccess = FALSE do begin
end;
try
clist := TCPServer1.Contexts.LockList;
for n := 0 to (clist.Count - 1) do begin
try
TIdContext (clist[n]).Connection.Socket.WriteBufferClear;
TIdContext (clist[n]).Connection.Socket.InputBuffer.Clear;
ip := TIdContext (clist[n]).Connection.Socket.Binding.PeerIP;
port := TIdContext (clist[n]).Connection.Socket.Binding.PeerPort;
TIdContext (clist[n]).Connection.Disconnect;
CL_DeleteClient (ip, port);
mmoLog.Lines.Add ('DISCON: ' + ip + ' : ' + IntToStr(port) + ' ' +
DateToStr (datetime) + ' ' + TimeToStr (datetime) );
sleep (100);
except
end;
end;
finally
TCPServer1.Contexts.UnlockList;
TCPServer1.Active := FALSE;
fSvrClose := FALSE;
LV_Refresh ();
end;
end;
end
);
end;
procedure THeaderFooterwithNavigation.btnListenClick(Sender: TObject);
var
port : Word;
begin
port := StrToInt (edtPort.Text);
TCPServer1.Contexts.Clear;
TCPServer1.Bindings.Clear();
if (port > 200) and (port < 65535) then begin
TCPServer1.DefaultPort := StrToInt (edtPort.Text);
end else
TCPServer1.DefaultPort := 30000;
TCPServer1.Bindings.Add.IPVersion := Id_IPv4;
if TCPServer1.Active = FALSE then begin
TCPServer1.Active := TRUE;
end;
end;
procedure THeaderFooterwithNavigation.btnSendClick(Sender: TObject);
var
ip : string;
port : Word;
item : Integer;
begin
item := LV.ItemIndex;
if (item > -1) then begin
ip := ClientsList.Items[item].IP;
port := ClientsList.Items[item].Port;
SendMessage (ip, port, edtSend.Text);
end;
end;
procedure THeaderFooterwithNavigation.Get_ClientsNum ();
var
{$IFDEF MSWINDOWS}
clist : TList;
{$ENDIF MSWINDOWS}
{$IFDEF Android}
clist : TList <TIdContext>;
{$ENDIF Android}
begin
try
clist := TCPServer1.Contexts.LockList();
Clients_Num := TCPServer1.Contexts.Count;
finally
TCPServer1.Contexts.UnlockList;
end;
end;
对于 Windows 或 Android，此代码不正确或不安全。它能奏效，纯属运气。这段代码中有很多危险的逻辑需要重写。
尝试更像这样的东西：
// TMyContext
constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
FQueue := TIdThreadSafeStringList.Create;
FEvent := TEvent.Create(nil, True, False, '');
end;
destructor TMyContext.Destroy;
begin
FQueue.Free;
FEvent.Free;
inherited;
end;
procedure TMyContext.AddMsgToQueue(const Msg: String);
begin
with FQueue.Lock do
try
Add(Msg);
FEvent.SetEvent;
finally
FQueue.Unlock;
end;
end;
function TMyContext.GetQueuedMsgs: TStrings;
var
List: TStringList;
begin
Result := nil;
if FEvent.WaitFor(1000) <> wrSignaled then Exit;
List := FQueue.Lock;
try
if List.Count > 0 then
begin
Result := TStringList.Create;
try
Result.Assign(List);
List.Clear;
except
Result.Free;
raise;
end;
end;
FEvent.ResetEvent;
finally
FQueue.Unlock;
end;
end;
// TCPServer
procedure THeaderFooterwithNavigation.LogMessage(Msg: string);
begin
TThread.Queue(nil,
procedure
begin
mmoLog.Lines.Add (Msg);
end
);
end;
procedure THeaderFooterwithNavigation.TCPServer1Connect(AContext: TIdContext);
var
clientIP : String;
clientPort: TIdPort;
datetime : TDateTime;
begin
datetime := now;
// CLIENT CON INFO
clientIP := AContext.Binding.PeerIP;
clientPort := AContext.Binding.PeerPort;
AContext.Connection.IOHandler.WriteLn('HELLO');
LogMessage('CONNECT: ' + clientIP + ' : ' + IntToStr(clientPort) + ' ' + DateToStr (datetime) + ' ' + TimeToStr (datetime));
TThread.Queue(nil,
procedure
var
client: string;
begin
client := clientIP + ':' + IntToStr(clientPort);
case TCPServer1.Contexts.Count of
1: edtPort1.Text := client;
2: edtPort2.Text := client;
end;
// CLIENTSDATA LIST
ClientsList.Add (' ', clientIP, clientPort);
LV_Refresh;
end
);
end;
procedure THeaderFooterwithNavigation.TCPServer1Disconnect(
AContext: TIdContext);
var
datetime : TDateTime;
clientIP : String;
clientPort: TIdPort;
begin
datetime := now;
// CLIENT CON INFO
clientIP := AContext.Binding.PeerIP;
clientPort := AContext.Binding.PeerPort;
LogMessage('DISCON: ' + clientIP + ' : ' + IntToStr(clientPort) + ' ' + DateToStr(datetime) + ' ' + TimeToStr(datetime));
TThread.Queue(nil,
procedure
var
client: string;
begin
client := clientIP + ':' + IntToStr(clientPort);
if edtPort1.Text = client then begin
edtPort1.Text := '';
end;
if edtPort2.Text = client then begin
edtPort2.Text := '';
end;
CL_DeleteClient (clientIP, clientPort);
if fSvrClose = FALSE then LV_Refresh;
end
);
end;
procedure THeaderFooterwithNavigation.TCPServer1Exception(AContext: TIdContext; AException: Exception);
begin
if fSvrClose = FALSE then
LogMessage ('Error: ' + AException.Message);
end;
procedure THeaderFooterwithNavigation.TCPServer1Execute(AContext: TIdContext);
var
buff : String;
List : TStrings;
I : Integer;
clientIP: String;
clientPort: TIdPort;
begin
if fSvrClose = TRUE then Exit;
// SEND MESSAGES TO THE CLIENTS
List := TMyContext(AContext).GetQueuedMsgs;
if List <> nil then
try
for I := 0 to List.Count-1 do
AContext.Connection.IOHandler.WriteLn(List[I]);
finally
List.Free;
end;
if fSvrClose = TRUE then Exit;
// READ MESSAGE FROM CLIENTS
if AContext.Connection.IOHandler.InputBufferIsEmpty then begin
AContext.Connection.IOHandler.CheckForDataOnSource(200);
AContext.Connection.IOHandler.CheckForDisconnect;
if fSvrClose = TRUE then Exit;
end;
if not AContext.Connection.IOHandler.InputBufferIsEmpty then begin
begin
buff := AContext.Connection.IOHandler.ReadLn;
if fSvrClose = TRUE then Exit;
clientIP := AContext.Binding.PeerIP;
clientPort := AContext.Binding.PeerPort;
TThread.Queue(nil,
procedure
var
client: string;
begin
client := clientIP + ':' + IntToStr(clientPort);
if edtPort1.Text = client then begin
edtRec1.Text := buff;
end;
if edtPort2.Text = client then begin
edtRec2.Text := buff;
end;
end
);
end;
end;
// USER INTERFACE
procedure THeaderFooterwithNavigation.SendMessage (const IP : String; port : TIdPort; const Msg: string);
var
I: Integer;
begin
with TCPServer1.Contexts.LockList do
try
for I := 0 to Count-1 do begin
with TMyContext(Items[I]) do begin
if (Binding <> nil) and (Binding.PeerIP = IP) and (Binding.PeerPort = port) then begin
AddMsgToQueue(Msg);
Exit;
end;
end;
end;
finally
TCPServer1.Contexts.UnlockList;
end;
end;
procedure THeaderFooterwithNavigation.Timer1Timer(Sender: TObject);
begin
Get_ClientsNum;
// UPDATE UI (USER INTERFACE)
UpdateUI;
end;
procedure THeaderFooterwithNavigation.TitleActionUpdate(Sender: TObject);
begin
if Sender is TCustomAction then
begin
if TabControl1.ActiveTab <> nil then
TCustomAction(Sender).Text := TabControl1.ActiveTab.Text
else
TCustomAction(Sender).Text := '';
end;
end;
procedure THeaderFooterwithNavigation.btnCloseClick(Sender: TObject);
begin
fSvrClose := TRUE;
// SERVER CLOSE
TCPServer1.Active := FALSE;
btnListen.Enabled := TRUE;
edtStatus.Text := 'CLOSED';
fSvrClose := FALSE;
LV_Refresh;
end;
procedure THeaderFooterwithNavigation.btnListenClick(Sender: TObject);
var
port : TIdPort;
begin
port := StrToInt (edtPort.Text);
TCPServer1.Active := False;
TCPServer1.Bindings.Clear;
if (port > 200) and (port < 65535) then begin
TCPServer1.DefaultPort := port;
end else
TCPServer1.DefaultPort := 30000;
TCPServer1.Bindings.Add.IPVersion := Id_IPv4;
TCPServer1.Active := TRUE;
btnListen.Enabled := FALSE;
edtStatus.Text := 'LISTENING';
end;
procedure THeaderFooterwithNavigation.btnSendClick(Sender: TObject);
var
ip : string;
port : Word;
item : Integer;
begin
item := LV.ItemIndex;
if (item > -1) then begin
ip := ClientsList.Items[item].IP;
port := ClientsList.Items[item].Port;
SendMessage (ip, port, edtSend.Text);
end;
end;
procedure THeaderFooterwithNavigation.Get_ClientsNum;
begin
Clients_Num := TCPServer1.Contexts.Count;
end;
几乎每次断开 client/clients 和停用服务器时都会出现此问题。 disconnect/deactivate 事件进展顺利的情况是有的，但只有当一个客户端连接时。当连接的客户端很少时，断开连接和停用事件总是出错。我已经测试了我的应用程序，即使所有 UI 功能都被禁用并且没有任何改进。
我的应用程序运行平稳稳定的唯一情况是在我手机上的 Android 5.0 Lollipop API 21 上。我可以一个接一个地断开所有客户端，我可以停用连接客户端的服务器，即使启用 UI 功能，一切也能正常工作。
也许在 Jelly Bean 或 Delphi 等旧版本的 Android 上需要进行一些系统配置？很遗憾我的平板无法升级到API 5.0.
确切地说，我将向您展示 UI 函数： （我正在制作自己的 ClientsList，因为我必须记住更多数据，例如设备名称或序列号。使用我自己的代码更容易。）
<code>
// ----------------------------------------------------------------- LIST VIEW
procedure THeaderFooterwithNavigation.LV_MakeLine;
var
Item : TListItem;
begin
Item := LV.Items.Add;
end;
procedure THeaderFooterwithNavigation.LV_AddData (index : Word);
var
Item : TListItem;
Client : TClientTcp;
ip : String;
port : String;
name : String;
begin
Client := ClientsList.Items [index];
Item := LV.Items.Item [index];
LV.Items.Item [index].Text := Client.Name + ' ' + Client.IP + ' : ' + IntToStr(Client.Port);
end;
procedure THeaderFooterwithNavigation.LV_Refresh;
var
i : Integer;
itms : Integer;
begin
LV.Items.Clear;
//LV.ClearItems;
itms := ClientsList.Count;
for i := 0 to itms-1 do begin
LV_MakeLine ();
LV_AddData (i);
end;
end;
procedure THeaderFooterwithNavigation.CL_DeleteClient (ip : String; port : Word);
var
cl_item : Integer;
begin
cl_item := ClientsList.FindClient_ByIpPort (ip, port);
if cl_item > (-1) then begin
// DELETE DISCONNECTED CLIENT FROM LIST AND SET LIST SIZE TO THE CLIENTS NUMBER
ClientsList.Delete (cl_item);
end;
end;
</p>
<p>和客户名单</p>
<pre>unit ServerTcpA;
interface
{
uses
SysUtils, Variants, Classes, Generics.Collections;
}
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
System.Generics.Collections;
{
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Contnrs, ComCtrls,
Buttons, WinSock, ScktComp;
}
type
// CLASS DECLARATIONS ----------------------------------------------------
// TClientTcp CLASS -----------------------------------------------------
TClientTcp = class (TObject)
public
Name : String;
IP : String;
Port : Integer;
RecFrames : Integer;
end;
// TClientsTcpList CLASS -------------------------------------------------
TClientsTcpList = class (TObjectList <TObject>)
private
function FGetItem (index : Integer) : TClientTcp;
public
property Items [index : Integer] : TClientTcp read FGetItem;
function Add (name : String; ip : String; port: Integer) : TClientTcp;
function FindClient_ByName (name : String) : TClientTcp;
function FindClient_ByIp (ip : String) : TClientTcp;
function FindClient_ByPort (port : Integer) : Integer;
function FindClient_ByIpPort (ip : String; port : Integer): Integer;
end;
// TTcpCfg CLASS ---------------------------------------------------------
TTcpCfg = class (TObject)
TcpClientsList : TClientsTcpList;
public
constructor Create;
destructor Destroy; override;
function AddClient (ip : String; port: Integer) : TClientTcp;
end;
// ENUM - Defined Column Names -------------------------------------------
type TColNames = (
COL_LP = 0,
COL_NAME,
COL_IP,
COL_PORT
);
const
NONE = -1;
var
//ServerTcpDK : TServerSocket;
//TCPCFG : TTcpCfg;
ClientsList : TClientsTcpList;
implementation
// =================================================== CLASS: TClientsTcpList
// GET ITEM
function TClientsTcpList.FGetItem (index : Integer) : TClientTcp;
begin
//Result := inherited GetItem (index) as TClientTcp;
Result := inherited Items [index] as TClientTcp;
end;
// ADD ITEM
function TClientsTcpList.Add (name : String; ip : String; port: Integer) : TClientTcp;
begin
if (FindClient_ByIpPort (ip, port) = NONE) then begin
Result := TClientTcp.Create;
Result.Name := name;
Result.IP := ip;
Result.Port := port;
Result.RecFrames := 0;
inherited Add (Result);
end;
end;
// FIND CLIENT: BY NAME
function TClientsTcpList.FindClient_ByName (name : String): TClientTcp;
var
i : integer;
begin
//Result := nil;
Result := nil;
for i:=0 to Count-1 do begin
if Items [i].Name = name then begin
Result := Items[i];
break;
end;
end;
end;
// FIND CLIENT: BY IP
function TClientsTcpList.FindClient_ByIp (ip : String): TClientTcp;
var
i : integer;
begin
//Result := nil;
Result := nil;
for i:=0 to Count-1 do begin
if Items [i].IP = ip then begin
Result := Items[i];
break;
end;
end;
end;
// FIND CLIENT: BY PORT ------------------------------------------------------
// @Ret: Item Index in the LIST
// -1: Not Found
function TClientsTcpList.FindClient_ByPort (port : Integer): Integer;
var
i : integer;
begin
Result := NONE;
for i:=0 to Count-1 do begin
if Items [i].Port = port then begin
Result := i;
break;
end;
end;
end;
// FIND CLIENT: BY IP AND PORT -----------------------------------------------
// @Ret: Item Index in the LIST
// -1: Not Found
function TClientsTcpList.FindClient_ByIpPort (ip : String; port : Integer): Integer;
var
i : integer;
begin
Result := NONE;
for i:=0 to Count-1 do begin
if (Items [i].IP = ip) and (Items [i].Port = port) then begin
Result := i;
break;
end;
end;
end;
// =========================================================== CLASS: TTcpCfg
constructor TTcpCfg.Create;
begin
inherited;
TcpClientsList := TClientsTcpList.Create;
end;
destructor TTcpCfg.Destroy;
begin
TcpClientsList.Free;
inherited;
end;
function TTcpCfg.AddClient (ip : String; port: Integer) : TClientTcp;
begin
Result := TClientTcp.Create;
//TcpClientsList.Add (Result);
Result.IP := ip;
Result.Port := port;
Result.RecFrames := 0;
end;
// ============================================================ INITIALIZATION
initialization
//ServerTcpDK := TServerSocket.Create (Nil);
//TCPCFG := TTcpCfg.Create;
ClientsList := TClientsTcpList.Create;
finalization
//ServerTcpDK.Free;
//TCPCFG.Free;
ClientsList.Free;
// @END OF FILE --------------------------------------------------------------
end.