为什么我的服务器应用程序在多个客户端连接后冻结？
Why My server application freeze after several clients connected?
我在我的服务器应用程序中使用 indy TidTcpserver 它工作正常但有时在 10 个客户端连接后我的服务器应用程序出现死锁并停止响应这里是我的服务器执行和广播协议代码
Tcp 服务器执行
procedure TfMain.TCPServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
Params: array[1..10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
IdBytes: TIdBytes;
MS: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
Size: Int64;
begin
Connection := Pointer(AContext.Data);
MS := TMemoryStream.Create;
ReceiveParams := False;
ReceiveStream := False;
Command := AContext.Connection.Socket.ReadLn; //read command
if Command[1] = '1' then //command with params
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
end
else if Command[1] = '2' then //command + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveStream := True;
MS.Position := 0;
end
else if Command[1] = '3' then //command with params + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
ReceiveStream := True;
end;
if ReceiveParams then //params is incomming
begin
AContext.Connection.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
ParamsCount := 0;
repeat
Inc(ParamsCount);
p := Pos(Sep, String(PackedParams.Params));
Params[ParamsCount] := Copy(String(PackedParams.Params), 1, P - 1);
Delete(PackedParams.Params, 1, P + 4);
until PackedParams.Params = '';
end;
if ReceiveStream then //stream is incomming
begin
Size := AContext.Connection.Socket.ReadInt64;
AContext.Connection.Socket.ReadStream(MS, Size, False);
MS.Position := 0;
end;
if Command = 'LOGIN' then
begin
usrnm := Params[1];
passwd := params[2];
if not userexists(usrnm, passwd) then
AContext.Connection.Socket.WriteLn('INVALIDPASSWORD')
else
begin
userslq.Close;
userslq.SQL.Clear;
userslq.SQL.Add('SELECT * FROM `users` WHERE `username` = "'+ trim(usrnm) +'" AND `password` = "' + trim(passwd) + '"');
userslq.Open;
if NOT userslq.IsEmpty then
begin
SendCommandWithParams(Connection, 'SENDYOURINFO', IntToStr(Connection.UniqueID) + Sep);
userslq.Close;
end;
userslq.Close;
userslq.SQL.Clear;
userslq.SQL.Add('UPDATE `users` SET `lastlogin` = :Date, `timeslogin`=(`timeslogin`+1) WHERE `users`.`username` = :uname;');
userslq.ParamByName('uname').AsString := trim(usrnm);
userslq.ParamByName('Date').AsDate := Now;
userslq.ExecSQL;
userslq.Close;
end;
end;
if Command = 'TAKEMYINFO' then //login ok, add to listview
begin
Connection.Name := Params[1];
Connections.Add(Connection);
AddConnectionToListView(Connection);
end;
if Command = 'TEXTMESSAGE' then
begin
BroadCastTextMessage(Params[1], Connection.UniqueID, Connection.Name, Connection.IP);
end;
if Command = 'DISCONNECTED' then
begin
DeleteConnectionFromList(Connection.UniqueID);
DeleteConnectionFromListView(Connection.UniqueID);
end;
MS.Free;
end;
广播协议及使用程序
procedure TfMain.AddConnectionToListView(Connection: TConnection);
begin
with lwConnections.Items.Add do
begin
Caption := Connection.Name;
SubItems.Add(Connection.IP);
SubItems.Add(FormatDateTime('hh:mm:ss', Connection.Connected));
SubItems.Add(IntToStr(Connection.UniqueID));
end;
end;
procedure TfMain.DeleteConnectionFromListView(UniqueID: DWord);
var
I: Integer;
begin
for I := 0 to lwConnections.Items.Count - 1 do
begin
if lwConnections.Items.Item[I].SubItems.Strings[2] = IntToStr(UniqueID) then
begin
lwConnections.Items.Delete(I);
Break;
end;
end;
end;
procedure TfMain.DeleteConnectionFromList(UniqueID: DWord);
var
I, Pos: Integer;
begin
Pos := -1;
for I := 0 to Connections.Count - 1 do
begin
if TConnection(Connections.Items[I]).UniqueID = UniqueID then
begin
Pos := I;
Break;
end;
end;
if Pos <> -1 then
Connections.Delete(Pos);
end;
procedure TfMain.BroadCastTextMessage(const TextMessage: String; const FromUniqueID: DWord;
const FromName: string; const dip: string);
var
I: Integer;
Connection: TConnection;
begin
for I := 0 to Connections.Count - 1 do
begin
Connection := Connections.Items[I];
if Connection.UniqueID <> FromUniqueID then
SendCommandWithParams(Connection, 'TEXTMESSAGE', FromName + Sep + TextMessage + Sep + dip + Sep);
end;
end;
procedure TfMain.SendCommandWithParams(Connection: TConnection; Command, Params:String);
var
PackedParams: TPackedParams;
begin
if not TIdContext(Connection.Thread).Connection.Socket.Connected then
Exit;
TCPServer.Contexts.LockList;
try
PackedParams.Params := ShortString(Params);
with TIdContext(Connection.Thread).Connection.Socket do
begin
WriteLn('1' + Command);
Write(RawToBytes(PackedParams, SizeOf(PackedParams)));
end;
finally
TCPServer.Contexts.UnlockList;
end;
end;
关于连接服务器事件
procedure Tfmain.TcpServerConnect(AContext: TIdContext);
var
Connection : TConnection;
begin
Connection := TConnection.Create;
Connection.IP := AContext.Connection.Socket.Binding.PeerIP;
Connection.Connected := Now;
Connection.UniqueID := GetTickCount;
if Connection.UniqueID = LastUniqueID then
Connection.UniqueID := GetTickCount + 1000;
LastUniqueID := Connection.UniqueID;
Connection.Thread := AContext;
AContext.Data := Connection;
end;
已更新
通过遵循雷米的回答和他的详细信息，我开始进行同步，但在雷米的回答中，我对 TCriticalSection 感到困惑，而且我将不得不重写客户端代码，以便能够像他的代码那样做，所以我必须首先使用线程同步这里是我按照雷米代码所做的事情的例子我暂时管理和删除了数据库以避免混淆这里是在服务器执行[=20]中尝试同步UI的代码=]
if Command = 'LOGIN' then
begin
if Password <> Params[1] then
AContext.Connection.Socket.WriteLn('INVALIDPASSWORD')
else
SendCommandWithParams(Connection, 'SENDYOURINFO', IntToStr(Connection.UniqueID) + Sep);
end;
if Command = 'TAKEMYINFO' then //login ok, add to listview
begin
Connection.Name := Params[1];
Connections.Add(Connection);
AddConnectionToListView(Connection);// this is not safe i know and thats what makes me confused so in this procedure call i do same as remy doing
end;
procedure TfMain.AddConnectionToListView(Connection: TConnection);
begin
TThread.Queue(nil,
procedure
var
Item: TListItem;
begin
Item := lwConnections.Items.Add;
try
Item.Caption := Connection.Name;
Item.SubItems.Add(Connection.IP);
Item.SubItems.Add(FormatDateTime('hh:mm:ss', Connection.Connected));
Item.SubItems.Add(IntToStr(Connection.UniqueID));
except
Item.Delete;
raise;
end;
end
);
end;
同步正确吗？让我感到困惑的是这个线程是自己同步的吗？我的意思是没有线程 class 来执行和同步这是正确的方法吗？
关于同步的更新
Remy 的回答对我很有帮助，我非常感谢他，但我正在尝试理解同步部分，我在 google 上找到了一些方法，例如包括
idsync 在我的使用中
并像这样称呼它作为例子
uses
idsync;
// and in server execute i call TiDNotify To synchronize what ever i want ?
procedure TfMain.DeleteConnectionFromListView;
var
I: Integer;
begin
for I := 0 to lwConnections.Items.Count - 1 do
begin
if lwConnections.Items.Item[I].SubItems.Strings[2] = IntToStr(linetToID) then
begin
DeleteConnectionFromList(linetToID);
lwConnections.Items.Delete(I);
Break;
end;
end;
end;
procedure TfMain.TCPServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
Params: array[1..10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
IdBytes: TIdBytes;
MS: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
Size: Int64;
begin
Connection := Pointer(AContext.Data);
MS := TMemoryStream.Create;
ReceiveParams := False;
ReceiveStream := False;
Command := AContext.Connection.Socket.ReadLn; //read command
if Command[1] = '1' then //command with params
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
end
else if Command[1] = '2' then //command + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveStream := True;
MS.Position := 0;
end
else if Command[1] = '3' then //command with params + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
ReceiveStream := True;
end;
if ReceiveParams then //params is incomming
begin
AContext.Connection.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
ParamsCount := 0;
repeat
Inc(ParamsCount);
p := Pos(Sep, String(PackedParams.Params));
Params[ParamsCount] := Copy(String(PackedParams.Params), 1, P - 1);
Delete(PackedParams.Params, 1, P + 4);
until PackedParams.Params = '';
end;
if ReceiveStream then //stream is incomming
begin
Size := AContext.Connection.Socket.ReadInt64;
AContext.Connection.Socket.ReadStream(MS, Size, False);
MS.Position := 0;
end;
if Command = 'LOGIN' then
begin
if Password <> Params[1] then
AContext.Connection.Socket.WriteLn('INVALIDPASSWORD')
else
SendCommandWithParams(Connection, 'SENDYOURINFO', IntToStr(Connection.UniqueID) + Sep);
end;
if Command = 'TAKEMYINFO' then //login ok, add to listview
begin
Connection.Name := Params[1];
Connections.Add(Connection);
TIdNotify.NotifyMethod(Connection.AddToListView);
end;
if Command = 'TEXTMESSAGE' then
begin
BroadCastTextMessage(Params[1], Connection.UniqueID);
end;
if Command = 'GETLIST' then
begin
SendClientsListTo(Connection.UniqueID);
end;
if Command = 'DISCONNECTED' then
begin
linetToID := Connection.UniqueID;// fmain private string variable
TIdNotify.NotifyMethod(DeleteConnectionFromListView);
end;
MS.Free;
end;
TIdTCPServer是一个多线程组件。它的 OnExecute 事件在工作线程的上下文中触发。但是您的 TAKEMYINFO 和 DISCONNECTED 命令处理程序 直接 访问 UI 控件而不与主 UI 线程同步。这很容易导致死锁（还有其他问题，包括崩溃、杀死 UI 等）。您必须同步！
此外，userexists() 是线程安全的吗？是userslq？您对 Connections 列表的使用绝对 不是 线程安全的。
为什么 SendCommandWithParams() 锁定服务器的 Contexts 列表，尤其是当被 OnExecute 调用时？你不需要那样做。您应该将其锁定在 BroadCastTextMessage() 中。
试试像这样的东西：
type
TConnnection = class(TIdServerContext)
private
WriteLock: TCriticalSection;
public
Name: String;
IP: String;
Connected: TDateTime;
UniqueID: Dword;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
procedure AddToListView;
procedure DeleteFromListView;
procedure BroadcastTextMessage(const TextMessage: String);
procedure SendCommandWithParams(const Command, Params: String);
procedure SendLn(const S: String);
function UserExists(const User, Passwd: string): Boolean;
procedure UpdateLastLogin(const User: String);
end;
constructor TConnection.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
WriteLock := TCriticalSection.Create;
end;
destructor TConnection.Destroy;
begin
WriteLock.Free;
inherited;
end;
procedure TConnection.AddToListView;
var
LName: string;
LIP: string;
LConnected: TDateTime;
LUniqueID: Dword;
begin
// in case the client disconnects and destroys this object before
// TThread.Queue() can update the ListView, capture the values so
// this object's fields are not accessed directly...
//
LName := Self.Name;
LIP := Self.IP;
LConnected := Self.Connected;
LUniqueID := Self.UniqueID;
TThread.Queue(nil,
procedure
var
Item: TListItem;
begin
if (fMain = nil) or (fMai.lwConnections = nil) then Exit;
Item := fMain.lwConnections.Items.Add;
try
Item.Data := Self;
Item.Caption := LName;
Item.SubItems.Add(LIP);
Item.SubItems.Add(FormatDateTime('hh:mm:ss', LConnected));
Item.SubItems.Add(IntToStr(LUniqueID));
except
Item.Delete;
raise;
end;
end
);
end;
procedure TConnection.DeleteFromListView;
begin
TThread.Queue(nil,
procedure
var
Item: TListItem;
begin
if (fMain = nil) or (fMai.lwConnections = nil) then Exit;
Item := fMain.lwConnections.FindData(0, Self, True, False);
if Item <> nil then Item.Delete;
end
);
end;
procedue TConnection.BroadCastTextMessage(const TextMessage: String);
var
List: TList; // or TIdContextList if using a modern Indy version
I: Integer;
Connection: TConnection;
begin
List := Server.Contexts.LockList;
try
for I := 0 to List.Count - 1 do
begin
Connection := TConnection(List.Items[I]);
if Connection <> Self then
begin
try
Connection.SendCommandWithParams('TEXTMESSAGE', FromName + Sep + TextMessage + Sep + dip + Sep);
except
end;
end;
finally
Server.Contexts.UnlockList;
end;
end;
procedure TConnection.SendCommandWithParams(const Command, Params: String);
var
PackedParams: TPackedParams;
begin
PackedParams.Params := ShortString(Params);
WriteLock.Enter;
try
with Connection.Socket do
begin
WriteLn('1' + Command);
Write(RawToBytes(PackedParams, SizeOf(PackedParams)));
end;
finally
WriteLock.Leave;
end;
end;
procedure TConnection.SendLn(const S: String);
begin
WriteLock.Enter;
try
Connection.Socket.WriteLn(S);
finally
WriteLock.Leave;
end;
end;
function TConnection.UserExists(const User, Passwd: string): Boolean;
var
Exists: Boolean;
begin
// if you give each client its own DB connection, or use
// a thread-safe DB pool, you don't have to sync this ...
//
TThread.Synchronize(nil,
procedure
if (fMain = nil) or (fMai.userslq = nil) then Exit;
with fMain.userslq do
begin
Close;
SQL.Text := 'SELECT * FROM `users` WHERE `username` = :uname AND `password` = :passwd;';
ParamByName('uname').AsString := Trim(User);
ParamByName('passwd').AsString := Trim(Passwd);
Open;
try
Exists := not IsEmpty;
finally
Close;
end;
end;
end
);
Result := Exists;
end;
procedure TConnection.UpdateLastLogin(const User: String);
begin
// if you give each client its own DB connection, or use
// a thread-safe DB pool, you don't have to sync this ...
//
TThread.Synchronize(nil,
procedure
if (fMain = nil) or (fMai.userslq = nil) then Exit;
with fMain.userslq do
begin
Close;
SQL.Text := 'UPDATE `users` SET `lastlogin` = :Date, `timeslogin`=(`timeslogin`+1) WHERE `users`.`username` = :uname;';
ParamByName('uname').AsString := Trim(User);
ParamByName('Date').AsDate := Now;
ExecSQL;
Close;
end;
end
);
end;
procedure TfMain.FormCreate(Sender: TObject);
begin
// set this before activating the server
TCPServer.ContextClass := TConnection;
end;
procedure TfMain.TCPServerConnect(AContext: TIdContext);
var
Connection: TConnection;
begin
Connection := AContext as TConnection;
Connection.Name := '';
Connection.IP := AContext.Binding.PeerIP;
Connection.Connected := Now;
Connection.UniqueID := ...;
end;
procedure TfMain.TCPServerDisconnect(AContext: TIdContext);
var
Connection: TConnection;
begin
Connection := AContext as TConnection;
Connection.DeleteFromListView;
end;
procedure TfMain.TCPServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
Params: array[1..10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
IdBytes: TIdBytes;
MS: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
S: String;
begin
Connection := AContext as TConnection;
Command := AContext.Connection.Socket.ReadLn; //read command
if Command = '' then Exit;
ReceiveParams := False;
ReceiveStream := False;
if Command[1] = '1' then //command with params
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := True;
end
else if Command[1] = '2' then //command + memorystream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveStream := True;
end
else if Command[1] = '3' then //command with params + memorystream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := True;
ReceiveStream := True;
end;
if ReceiveParams then //params is incomming
begin
AContext.Connection.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
S := String(PackedParams.Params);
ParamsCount := 0;
while (S <> '') and (ParamsCount < 10) do
begin
Inc(ParamsCount);
p := Pos(Sep, S);
if p = 0 then
Params[ParamsCount] := S
else
begin
Params[ParamsCount] := Copy(S, 1, P - 1);
Delete(S, 1, P + 4);
end;
end;
end;
MS := nil;
try
if ReceiveStream then //stream is incomming
begin
MS := TMemoryStream.Create;
AContext.Connection.Socket.LargeStream := True;
AContext.Connection.Socket.ReadStream(MS, -1, False);
MS.Position := 0;
end;
if Command = 'LOGIN' then
begin
if ParamsCount <> 2 then
begin
Connection.SendLn('INVALIDPARAMS');
Exit;
end;
if not Connection.UserExists(Params[1], Params[2]) then
begin
Connection.SendLn('INVALIDPASSWORD');
Exit;
end;
Connection.UpdateLastLogin(Params[1]);
Connection.SendCommandWithParams('SENDYOURINFO', IntToStr(Connection.UniqueID) + Sep);
end
else if Command = 'TAKEMYINFO' then //login ok, add to listview
begin
if ParamsCount <> 1 then
begin
Connection.SendLn('INVALIDPARAMS');
Exit;
end;
Connection.Name := Params[1];
Connection.AddToListView;
end
else if Command = 'TEXTMESSAGE' then
begin
if ParamsCount <> 1 then
begin
Connection.SendLn('INVALIDPARAMS');
Exit;
end;
Connection.BroadCastTextMessage(Params[1]);
end
else if Command = 'DISCONNECTED' then
begin
AContext.Connection.Disconnect;
Exit;
end;
finally
MS.Free;
end;
end;
我在我的服务器应用程序中使用 indy TidTcpserver 它工作正常但有时在 10 个客户端连接后我的服务器应用程序出现死锁并停止响应这里是我的服务器执行和广播协议代码
Tcp 服务器执行
procedure TfMain.TCPServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
Params: array[1..10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
IdBytes: TIdBytes;
MS: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
Size: Int64;
begin
Connection := Pointer(AContext.Data);
MS := TMemoryStream.Create;
ReceiveParams := False;
ReceiveStream := False;
Command := AContext.Connection.Socket.ReadLn; //read command
if Command[1] = '1' then //command with params
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
end
else if Command[1] = '2' then //command + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveStream := True;
MS.Position := 0;
end
else if Command[1] = '3' then //command with params + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
ReceiveStream := True;
end;
if ReceiveParams then //params is incomming
begin
AContext.Connection.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
ParamsCount := 0;
repeat
Inc(ParamsCount);
p := Pos(Sep, String(PackedParams.Params));
Params[ParamsCount] := Copy(String(PackedParams.Params), 1, P - 1);
Delete(PackedParams.Params, 1, P + 4);
until PackedParams.Params = '';
end;
if ReceiveStream then //stream is incomming
begin
Size := AContext.Connection.Socket.ReadInt64;
AContext.Connection.Socket.ReadStream(MS, Size, False);
MS.Position := 0;
end;
if Command = 'LOGIN' then
begin
usrnm := Params[1];
passwd := params[2];
if not userexists(usrnm, passwd) then
AContext.Connection.Socket.WriteLn('INVALIDPASSWORD')
else
begin
userslq.Close;
userslq.SQL.Clear;
userslq.SQL.Add('SELECT * FROM `users` WHERE `username` = "'+ trim(usrnm) +'" AND `password` = "' + trim(passwd) + '"');
userslq.Open;
if NOT userslq.IsEmpty then
begin
SendCommandWithParams(Connection, 'SENDYOURINFO', IntToStr(Connection.UniqueID) + Sep);
userslq.Close;
end;
userslq.Close;
userslq.SQL.Clear;
userslq.SQL.Add('UPDATE `users` SET `lastlogin` = :Date, `timeslogin`=(`timeslogin`+1) WHERE `users`.`username` = :uname;');
userslq.ParamByName('uname').AsString := trim(usrnm);
userslq.ParamByName('Date').AsDate := Now;
userslq.ExecSQL;
userslq.Close;
end;
end;
if Command = 'TAKEMYINFO' then //login ok, add to listview
begin
Connection.Name := Params[1];
Connections.Add(Connection);
AddConnectionToListView(Connection);
end;
if Command = 'TEXTMESSAGE' then
begin
BroadCastTextMessage(Params[1], Connection.UniqueID, Connection.Name, Connection.IP);
end;
if Command = 'DISCONNECTED' then
begin
DeleteConnectionFromList(Connection.UniqueID);
DeleteConnectionFromListView(Connection.UniqueID);
end;
MS.Free;
end;
广播协议及使用程序
procedure TfMain.AddConnectionToListView(Connection: TConnection);
begin
with lwConnections.Items.Add do
begin
Caption := Connection.Name;
SubItems.Add(Connection.IP);
SubItems.Add(FormatDateTime('hh:mm:ss', Connection.Connected));
SubItems.Add(IntToStr(Connection.UniqueID));
end;
end;
procedure TfMain.DeleteConnectionFromListView(UniqueID: DWord);
var
I: Integer;
begin
for I := 0 to lwConnections.Items.Count - 1 do
begin
if lwConnections.Items.Item[I].SubItems.Strings[2] = IntToStr(UniqueID) then
begin
lwConnections.Items.Delete(I);
Break;
end;
end;
end;
procedure TfMain.DeleteConnectionFromList(UniqueID: DWord);
var
I, Pos: Integer;
begin
Pos := -1;
for I := 0 to Connections.Count - 1 do
begin
if TConnection(Connections.Items[I]).UniqueID = UniqueID then
begin
Pos := I;
Break;
end;
end;
if Pos <> -1 then
Connections.Delete(Pos);
end;
procedure TfMain.BroadCastTextMessage(const TextMessage: String; const FromUniqueID: DWord;
const FromName: string; const dip: string);
var
I: Integer;
Connection: TConnection;
begin
for I := 0 to Connections.Count - 1 do
begin
Connection := Connections.Items[I];
if Connection.UniqueID <> FromUniqueID then
SendCommandWithParams(Connection, 'TEXTMESSAGE', FromName + Sep + TextMessage + Sep + dip + Sep);
end;
end;
procedure TfMain.SendCommandWithParams(Connection: TConnection; Command, Params:String);
var
PackedParams: TPackedParams;
begin
if not TIdContext(Connection.Thread).Connection.Socket.Connected then
Exit;
TCPServer.Contexts.LockList;
try
PackedParams.Params := ShortString(Params);
with TIdContext(Connection.Thread).Connection.Socket do
begin
WriteLn('1' + Command);
Write(RawToBytes(PackedParams, SizeOf(PackedParams)));
end;
finally
TCPServer.Contexts.UnlockList;
end;
end;
关于连接服务器事件
procedure Tfmain.TcpServerConnect(AContext: TIdContext);
var
Connection : TConnection;
begin
Connection := TConnection.Create;
Connection.IP := AContext.Connection.Socket.Binding.PeerIP;
Connection.Connected := Now;
Connection.UniqueID := GetTickCount;
if Connection.UniqueID = LastUniqueID then
Connection.UniqueID := GetTickCount + 1000;
LastUniqueID := Connection.UniqueID;
Connection.Thread := AContext;
AContext.Data := Connection;
end;
已更新
通过遵循雷米的回答和他的详细信息，我开始进行同步，但在雷米的回答中，我对 TCriticalSection 感到困惑，而且我将不得不重写客户端代码，以便能够像他的代码那样做，所以我必须首先使用线程同步这里是我按照雷米代码所做的事情的例子我暂时管理和删除了数据库以避免混淆这里是在服务器执行[=20]中尝试同步UI的代码=]
if Command = 'LOGIN' then
begin
if Password <> Params[1] then
AContext.Connection.Socket.WriteLn('INVALIDPASSWORD')
else
SendCommandWithParams(Connection, 'SENDYOURINFO', IntToStr(Connection.UniqueID) + Sep);
end;
if Command = 'TAKEMYINFO' then //login ok, add to listview
begin
Connection.Name := Params[1];
Connections.Add(Connection);
AddConnectionToListView(Connection);// this is not safe i know and thats what makes me confused so in this procedure call i do same as remy doing
end;
procedure TfMain.AddConnectionToListView(Connection: TConnection);
begin
TThread.Queue(nil,
procedure
var
Item: TListItem;
begin
Item := lwConnections.Items.Add;
try
Item.Caption := Connection.Name;
Item.SubItems.Add(Connection.IP);
Item.SubItems.Add(FormatDateTime('hh:mm:ss', Connection.Connected));
Item.SubItems.Add(IntToStr(Connection.UniqueID));
except
Item.Delete;
raise;
end;
end
);
end;
同步正确吗？让我感到困惑的是这个线程是自己同步的吗？我的意思是没有线程 class 来执行和同步这是正确的方法吗？
关于同步的更新
Remy 的回答对我很有帮助，我非常感谢他，但我正在尝试理解同步部分，我在 google 上找到了一些方法，例如包括
idsync 在我的使用中
并像这样称呼它作为例子
uses
idsync;
// and in server execute i call TiDNotify To synchronize what ever i want ?
procedure TfMain.DeleteConnectionFromListView;
var
I: Integer;
begin
for I := 0 to lwConnections.Items.Count - 1 do
begin
if lwConnections.Items.Item[I].SubItems.Strings[2] = IntToStr(linetToID) then
begin
DeleteConnectionFromList(linetToID);
lwConnections.Items.Delete(I);
Break;
end;
end;
end;
procedure TfMain.TCPServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
Params: array[1..10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
IdBytes: TIdBytes;
MS: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
Size: Int64;
begin
Connection := Pointer(AContext.Data);
MS := TMemoryStream.Create;
ReceiveParams := False;
ReceiveStream := False;
Command := AContext.Connection.Socket.ReadLn; //read command
if Command[1] = '1' then //command with params
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
end
else if Command[1] = '2' then //command + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveStream := True;
MS.Position := 0;
end
else if Command[1] = '3' then //command with params + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
ReceiveStream := True;
end;
if ReceiveParams then //params is incomming
begin
AContext.Connection.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
ParamsCount := 0;
repeat
Inc(ParamsCount);
p := Pos(Sep, String(PackedParams.Params));
Params[ParamsCount] := Copy(String(PackedParams.Params), 1, P - 1);
Delete(PackedParams.Params, 1, P + 4);
until PackedParams.Params = '';
end;
if ReceiveStream then //stream is incomming
begin
Size := AContext.Connection.Socket.ReadInt64;
AContext.Connection.Socket.ReadStream(MS, Size, False);
MS.Position := 0;
end;
if Command = 'LOGIN' then
begin
if Password <> Params[1] then
AContext.Connection.Socket.WriteLn('INVALIDPASSWORD')
else
SendCommandWithParams(Connection, 'SENDYOURINFO', IntToStr(Connection.UniqueID) + Sep);
end;
if Command = 'TAKEMYINFO' then //login ok, add to listview
begin
Connection.Name := Params[1];
Connections.Add(Connection);
TIdNotify.NotifyMethod(Connection.AddToListView);
end;
if Command = 'TEXTMESSAGE' then
begin
BroadCastTextMessage(Params[1], Connection.UniqueID);
end;
if Command = 'GETLIST' then
begin
SendClientsListTo(Connection.UniqueID);
end;
if Command = 'DISCONNECTED' then
begin
linetToID := Connection.UniqueID;// fmain private string variable
TIdNotify.NotifyMethod(DeleteConnectionFromListView);
end;
MS.Free;
end;
TIdTCPServer是一个多线程组件。它的 OnExecute 事件在工作线程的上下文中触发。但是您的 TAKEMYINFO 和 DISCONNECTED 命令处理程序 直接 访问 UI 控件而不与主 UI 线程同步。这很容易导致死锁（还有其他问题，包括崩溃、杀死 UI 等）。您必须同步！
此外，userexists() 是线程安全的吗？是userslq？您对 Connections 列表的使用绝对 不是 线程安全的。
为什么 SendCommandWithParams() 锁定服务器的 Contexts 列表，尤其是当被 OnExecute 调用时？你不需要那样做。您应该将其锁定在 BroadCastTextMessage() 中。
试试像这样的东西：
type
TConnnection = class(TIdServerContext)
private
WriteLock: TCriticalSection;
public
Name: String;
IP: String;
Connected: TDateTime;
UniqueID: Dword;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
procedure AddToListView;
procedure DeleteFromListView;
procedure BroadcastTextMessage(const TextMessage: String);
procedure SendCommandWithParams(const Command, Params: String);
procedure SendLn(const S: String);
function UserExists(const User, Passwd: string): Boolean;
procedure UpdateLastLogin(const User: String);
end;
constructor TConnection.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
WriteLock := TCriticalSection.Create;
end;
destructor TConnection.Destroy;
begin
WriteLock.Free;
inherited;
end;
procedure TConnection.AddToListView;
var
LName: string;
LIP: string;
LConnected: TDateTime;
LUniqueID: Dword;
begin
// in case the client disconnects and destroys this object before
// TThread.Queue() can update the ListView, capture the values so
// this object's fields are not accessed directly...
//
LName := Self.Name;
LIP := Self.IP;
LConnected := Self.Connected;
LUniqueID := Self.UniqueID;
TThread.Queue(nil,
procedure
var
Item: TListItem;
begin
if (fMain = nil) or (fMai.lwConnections = nil) then Exit;
Item := fMain.lwConnections.Items.Add;
try
Item.Data := Self;
Item.Caption := LName;
Item.SubItems.Add(LIP);
Item.SubItems.Add(FormatDateTime('hh:mm:ss', LConnected));
Item.SubItems.Add(IntToStr(LUniqueID));
except
Item.Delete;
raise;
end;
end
);
end;
procedure TConnection.DeleteFromListView;
begin
TThread.Queue(nil,
procedure
var
Item: TListItem;
begin
if (fMain = nil) or (fMai.lwConnections = nil) then Exit;
Item := fMain.lwConnections.FindData(0, Self, True, False);
if Item <> nil then Item.Delete;
end
);
end;
procedue TConnection.BroadCastTextMessage(const TextMessage: String);
var
List: TList; // or TIdContextList if using a modern Indy version
I: Integer;
Connection: TConnection;
begin
List := Server.Contexts.LockList;
try
for I := 0 to List.Count - 1 do
begin
Connection := TConnection(List.Items[I]);
if Connection <> Self then
begin
try
Connection.SendCommandWithParams('TEXTMESSAGE', FromName + Sep + TextMessage + Sep + dip + Sep);
except
end;
end;
finally
Server.Contexts.UnlockList;
end;
end;
procedure TConnection.SendCommandWithParams(const Command, Params: String);
var
PackedParams: TPackedParams;
begin
PackedParams.Params := ShortString(Params);
WriteLock.Enter;
try
with Connection.Socket do
begin
WriteLn('1' + Command);
Write(RawToBytes(PackedParams, SizeOf(PackedParams)));
end;
finally
WriteLock.Leave;
end;
end;
procedure TConnection.SendLn(const S: String);
begin
WriteLock.Enter;
try
Connection.Socket.WriteLn(S);
finally
WriteLock.Leave;
end;
end;
function TConnection.UserExists(const User, Passwd: string): Boolean;
var
Exists: Boolean;
begin
// if you give each client its own DB connection, or use
// a thread-safe DB pool, you don't have to sync this ...
//
TThread.Synchronize(nil,
procedure
if (fMain = nil) or (fMai.userslq = nil) then Exit;
with fMain.userslq do
begin
Close;
SQL.Text := 'SELECT * FROM `users` WHERE `username` = :uname AND `password` = :passwd;';
ParamByName('uname').AsString := Trim(User);
ParamByName('passwd').AsString := Trim(Passwd);
Open;
try
Exists := not IsEmpty;
finally
Close;
end;
end;
end
);
Result := Exists;
end;
procedure TConnection.UpdateLastLogin(const User: String);
begin
// if you give each client its own DB connection, or use
// a thread-safe DB pool, you don't have to sync this ...
//
TThread.Synchronize(nil,
procedure
if (fMain = nil) or (fMai.userslq = nil) then Exit;
with fMain.userslq do
begin
Close;
SQL.Text := 'UPDATE `users` SET `lastlogin` = :Date, `timeslogin`=(`timeslogin`+1) WHERE `users`.`username` = :uname;';
ParamByName('uname').AsString := Trim(User);
ParamByName('Date').AsDate := Now;
ExecSQL;
Close;
end;
end
);
end;
procedure TfMain.FormCreate(Sender: TObject);
begin
// set this before activating the server
TCPServer.ContextClass := TConnection;
end;
procedure TfMain.TCPServerConnect(AContext: TIdContext);
var
Connection: TConnection;
begin
Connection := AContext as TConnection;
Connection.Name := '';
Connection.IP := AContext.Binding.PeerIP;
Connection.Connected := Now;
Connection.UniqueID := ...;
end;
procedure TfMain.TCPServerDisconnect(AContext: TIdContext);
var
Connection: TConnection;
begin
Connection := AContext as TConnection;
Connection.DeleteFromListView;
end;
procedure TfMain.TCPServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
Params: array[1..10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
IdBytes: TIdBytes;
MS: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
S: String;
begin
Connection := AContext as TConnection;
Command := AContext.Connection.Socket.ReadLn; //read command
if Command = '' then Exit;
ReceiveParams := False;
ReceiveStream := False;
if Command[1] = '1' then //command with params
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := True;
end
else if Command[1] = '2' then //command + memorystream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveStream := True;
end
else if Command[1] = '3' then //command with params + memorystream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := True;
ReceiveStream := True;
end;
if ReceiveParams then //params is incomming
begin
AContext.Connection.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
S := String(PackedParams.Params);
ParamsCount := 0;
while (S <> '') and (ParamsCount < 10) do
begin
Inc(ParamsCount);
p := Pos(Sep, S);
if p = 0 then
Params[ParamsCount] := S
else
begin
Params[ParamsCount] := Copy(S, 1, P - 1);
Delete(S, 1, P + 4);
end;
end;
end;
MS := nil;
try
if ReceiveStream then //stream is incomming
begin
MS := TMemoryStream.Create;
AContext.Connection.Socket.LargeStream := True;
AContext.Connection.Socket.ReadStream(MS, -1, False);
MS.Position := 0;
end;
if Command = 'LOGIN' then
begin
if ParamsCount <> 2 then
begin
Connection.SendLn('INVALIDPARAMS');
Exit;
end;
if not Connection.UserExists(Params[1], Params[2]) then
begin
Connection.SendLn('INVALIDPASSWORD');
Exit;
end;
Connection.UpdateLastLogin(Params[1]);
Connection.SendCommandWithParams('SENDYOURINFO', IntToStr(Connection.UniqueID) + Sep);
end
else if Command = 'TAKEMYINFO' then //login ok, add to listview
begin
if ParamsCount <> 1 then
begin
Connection.SendLn('INVALIDPARAMS');
Exit;
end;
Connection.Name := Params[1];
Connection.AddToListView;
end
else if Command = 'TEXTMESSAGE' then
begin
if ParamsCount <> 1 then
begin
Connection.SendLn('INVALIDPARAMS');
Exit;
end;
Connection.BroadCastTextMessage(Params[1]);
end
else if Command = 'DISCONNECTED' then
begin
AContext.Connection.Disconnect;
Exit;
end;
finally
MS.Free;
end;
end;