为什么我的服务器应用程序在连接多个客

时间：2015-09-15 21:31:21

标签： indy delphi-xe7

我在我的服务器应用程序中使用indy TidTcpserver它的工作正常，但有些时候连接10个客户端之后我的服务器应用程序出现死锁并停止响应这里是我的服务器执行和广播协议代码< / p>

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感到困惑我也将不得不重写客户端代码，以便能够像他的代码那样做，所以我不得不首先使用线程同步这里是我通过以下remy代码做的例子我做了一些管理和暂时删除数据库以避免混淆这里是在服务器执行中尝试同步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;

这是正确的同步吗？什么让我困惑的是这个线程自己同步？我的意思是没有线程类可以执行和同步这是正确的方法吗？

有关同步的更新

雷米回答帮助我，我太感谢他了，但我试图理解因此同步部分我在谷歌找到一些方法作为例子包括 在我的使用中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;

1 个答案:

答案 0 :(得分：1)

function findweek($date, $type = "l") { $time = strtotime($date); return date($type, mktime(0, 0, 0, date("m", $time) , date("d", $time)-date("d", $time)+1, date("Y", $time))); } echo findweek('2015-09-16'); 是一个多线程组件。其TIdTCPServer事件在工作线程的上下文中触发。但是您的OnExecute和TAKEMYINFO命令处理程序直接访问UI控件而不与主UI线程同步。这很容易导致死锁（包括其他问题，包括崩溃，杀死用户界面等）。你必须同步！

另外，DISCONNECTED线程安全吗？是userexists()吗？您对userslq列表的使用肯定是不线程安全。

为什么Connections会锁定服务器的SendCommandWithParams()列表，尤其是在Contexts调用时？你不需要这样做。您应该将其锁定在OnExecute中。

尝试更像这样的事情：

BroadCastTextMessage()
相关问题
最新问题