Question

我一直坚持这个问题，我不知道我做错了什么。我正在使用indy10作为消息服务器，现在它工作正常并且似乎无法生成任何泄漏报告但是当我运行服务器实时并且用户数量上升时我的服务器开始吃掉内存，它每天吃掉高达500mb。我不知道这里是否有人有时间阅读代码，并指出我做错了什么，我因为这个问题而疯狂。任何帮助将非常感激。我发布了如何处理数据的代码。

IdTcpServer上下文的类

TRoomContext = class(TIdServerContext)
  private
    Procedure ProcessPacket(Buffer: Pointer; BufSize: Integer; Context: Pointer);
    Procedure AddToPacketBuffer(Buffer: Pointer; Size: Integer);
    Procedure CheckAndProcessPacket(Context: Pointer);
    Procedure DropInvalidPacket;
  public
    Username: TIdThreadSafeString;
    RoomName: TIdThreadSafeString;
    Stat: TIdThreadSafeCardinal;
    Color: TIdThreadSafeCardinal;
    Mute: TIdThreadSafeBoolean;
    ClientSubscription: TIdThreadSafeInteger;
    ClientPrivilege: TIdThreadSafeInteger;
    Room: Pointer;
    RoomUser: Pointer;
    Queue: TIdThreadSafeList;
    FPacketBuffer: Pointer;
    PacketBufferPtr: Integer;
    LastReadTime: TIdThreadSafeDateTime;
    LastMessagesReadTime: TIdThreadSafeDateTime;
    TimeOut: TIdThreadSafeInteger;
    Bounded: TIdThreadSafeBoolean;
    NumberOfPackets: TIdThreadSafeInteger;

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

构造函数和析构函数

constructor TRoomContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
  inherited;
  Queue     := TIdThreadSafeList.Create;
  Username  := TIdThreadSafeString.Create;
  RoomName  := TIdThreadSafeString.Create;
  Stat      := TIdThreadSafeCardinal.Create;
  Color     := TIdThreadSafeCardinal.Create;
  Mute      := TIdThreadSafeBoolean.Create;
  ClientSubscription := TIdThreadSafeInteger.Create;
  NumberOfPackets := TIdThreadSafeInteger.Create;
  ClientPrivilege := TIdThreadSafeInteger.Create;
  TimeOut   := TIdThreadSafeInteger.Create;
  Bounded   := TIdThreadSafeBoolean.Create;
  LastReadTime := TIdThreadSafeDateTime.Create;
  LastMessagesReadTime := TIdThreadSafeDateTime.Create;
  GetMem(FPacketBuffer,65536);

  Queue.Clear;
  Username.Value  := '';
  RoomName.Value  := '';
  Stat.Value      := 0;
  Color.Value     := 0;
  Mute.Value      := False;
  ClientSubscription.Value := 0;
  NumberOfPackets.Value := 0;
  ClientPrivilege.Value := 0;
  TimeOut.Value := 0;
  Bounded.Value := False;
  LastReadTime.Value := Now;
  LastMessagesReadTime.Value := Now;

  Room := Nil;
  RoomUser := Nil;
end;

destructor TRoomContext.Destroy;
Var tmpQueue: TList;
    outBuffer: Pointer;
begin
// Incase the user gets disconnected and there is leftover packets in the queue
  tmpQueue := Queue.LockList;
  Try
    While tmpQueue.Count > 0 Do Begin
      outBuffer := tmpQueue.items[0];
      If outBuffer <> Nil Then Begin
        FreeMemAndNil(outBuffer);
      End;
      tmpQueue.Delete(0);
    End;
    tmpQueue.Clear;
  Finally
    Queue.UnlockList;
  End;
  FreeAndNil(Queue);

  Username.Value := '';
  FreeAndNil(Username);

  RoomName.Value := '';
  FreeAndNil(RoomName);

  Stat.Value := 0;
  FreeAndNil(Stat);

  Color.Value := 0;
  FreeAndNil(Color);

  FreeAndNil(Mute);
  FreeAndNil(ClientSubscription);
  FreeAndNil(NumberOfPackets);
  FreeAndNil(ClientPrivilege);
  FreeAndNil(TimeOut);
  FreeAndNil(Bounded);
  FreeAndNil(LastReadTime);
  FreeAndNil(LastMessagesReadTime);
  FreeMemAndNil(FPacketBuffer, 65536);
  inherited;
end;

OnExecute Event

    Procedure TMainFrm.RoomSckExecute(AContext: TIdContext);
    Var Buf, outBuf: TIdBytes;
        Len, outLen: Integer;
        Buffer, outBuffer: Pointer;

        tmpQueue, tmpList: TList;
        Connected: Boolean;
    Begin
      Sleep(10);
      Try
        Connected := AContext.Connection.Connected;
      Except
        Connected := False;
      End;

      If Not Connected Then AContext.Connection.Disconnect;

        Len := AContext.Connection.IOHandler.InputBuffer.Size;
        If Len>0 then
        begin
          AContext.Connection.IOHandler.ReadBytes(Buf,Len,False);
          Try
            if Len<65536 then
            begin
              GetMem(Buffer,Len);
              Try
                CopyMemory(Buffer,@Buf[0],Len);
                TRoomContext(AContext).ProcessPacket(Buffer,Len, AContext);
              Finally
                  FreeMemAndNil(Buffer, Len);
              End;
              Sleep(10);
            end
            else
            begin     // Packet is to long: disconnect user and log event
            end;
          Finally
            SetLength(Buf,0);
          End;
        end;



      If Not TRoomContext(AContext).Queue.IsEmpty Then Begin
        tmpList := TList.Create;
        Try
          tmpQueue := TRoomContext(AContext).Queue.LockList;
          Try
            If tmpQueue.Count > 0 Then Begin
              tmpList.Assign(tmpQueue);
              tmpQueue.Clear;
            End;
          Finally
            TRoomContext(AContext).Queue.UnlockList;
          End;

          While tmpList.Count > 0 Do Begin
            outBuffer := tmpList.items[0];
            outLen := PCommunicatorPacket(outBuffer).BufferSize;
            SetLength(outBuf,outLen);
            Try
              CopyMemory(@outBuf[0],outBuffer,outLen);
              tmpList.Delete(0);
            Finally
              If outBuffer <> Nil Then Begin
                FreeMemAndNil(outBuffer);
              End;
            End;

            Try
              If Connected Then
                AContext.Connection.IOHandler.Write(outBuf)
            Finally
              SetLength(outBuf,0);
            End;
          End;
        Finally
          Try
            While tmpList.Count > 0 Do Begin
              outBuffer := tmpList.items[0];
              If outBuffer <> Nil Then Begin
                FreeMemAndNil(outBuffer);
              End;
              tmpList.Delete(0);
            End;
          Finally
            FreeAndNil(tmpList);
          End;
        End;
      End;

      If (MilliSecondsBetween(Now,TRoomContext(AContext).LastReadTime.Value)>RoomTimeOutVal) Then
        AContext.Connection.Disconnect;
    End;

ProcessPacket＆amp;从OnExecute Event

调用的相关函数

procedure TRoomContext.ProcessPacket(Buffer: Pointer; BufSize: Integer; Context: Pointer);
begin
  AddToPacketBuffer(Buffer,BufSize);
  CheckAndProcessPacket(Context);
end;

procedure TRoomContext.AddToPacketBuffer(Buffer: Pointer; Size: Integer);
var
  DestPtr: Pointer;
begin
  if PacketBufferPtr + Size<65536 then
  begin
    DestPtr := Pointer(Cardinal(FPacketBuffer)+Cardinal(PacketBufferPtr));
    Move(Buffer^,DestPtr^,Size);
    PacketBufferPtr := PacketBufferPtr + Size;
  end
  else
  begin
  end;
end;

procedure TRoomContext.CheckAndProcessPacket(Context: Pointer);
var
  DestPtr: Pointer;
  NewPacketBufferLen: Integer;
  SharedBuff: Pointer;
begin
  while PCommunicatorPacket(FPacketBuffer).BufferSize <= PacketBufferPtr do
  begin
    if PCommunicatorPacket(FPacketBuffer).Signature = PACKET_SIGNATURE then
    begin
      GetMem(SharedBuff,PCommunicatorPacket(FPacketBuffer).BufferSize);
      Try
        CopyMemory(SharedBuff,FPacketBuffer,PCommunicatorPacket(FPacketBuffer).BufferSize);
        MainFrm.ExecuteRoomPacket(SharedBuff, Context);
      Finally
        If SharedBuff <> Nil Then FreeMemAndNil(SharedBuff);
      End;
    end
    else
    begin
      DropInvalidPacket;
      Exit;  //we can not continue here because if there is no valid header signature found user thread will hang.
    end;
    NewPacketBufferLen := PacketBufferPtr - PCommunicatorPacket(FPacketBuffer).BufferSize;
    DestPtr := Pointer(Cardinal(FPacketBuffer)+PCommunicatorPacket(FPacketBuffer).BufferSize);
    Move(DestPtr^, FPacketBuffer^, NewPacketBufferLen);
    PacketBufferPtr := NewPacketBufferLen;
  end;
end;

procedure TRoomContext.DropInvalidPacket;
var
  i: Integer;
  DestPtr: Pointer;
  NewPacketBufferLen: Integer;
  Location: Integer;
begin
  Location := -1;
  for i := 0 to PacketBufferPtr - 2 do
    if PCommunicatorPacket(Cardinal(FPacketBuffer)+Cardinal(i)).Signature = PACKET_SIGNATURE then
    begin
      Location := i;
      break;
    end;
  If Location=-1 Then Location := PacketBufferPtr;
  if Location>0 then
  begin
    NewPacketBufferLen := PacketBufferPtr - Location;
    DestPtr := Pointer(Cardinal(FPacketBuffer)+Cardinal(Location));
    Move(DestPtr^, FPacketBuffer^, NewPacketBufferLen);
    PacketBufferPtr := NewPacketBufferLen;
  end;
end;


Procedure TMainFrm.ExecuteRoomPacket(Packet: PCommunicatorPacket; Context: Pointer);
Begin
  TRoomContext(Context).LastReadTime.Value := Now;
  Case Packet.DataType Of
    pdtGroupMessage: ProcessGroupMessagePacket(PGroupMessagePacket(Packet), Context);
    pdtGroupVoicePacket: ProcessGroupVoicePacket(PGroupVoicePacket(Packet), Context);
  end;
End;

Procedure TMainFrm.ProcessGroupMessagePacket(Packet: PGroupMessagePacket; Context: Pointer);
Var Username: String;
    Status: Cardinal;
    Room: TRoom;
    TmpStr: String;
Begin
If Context = Nil Then Exit;
If TRoomContext(Context).Username.Value = '' Then Exit;
  Username := Packet.UserName;
If LowerCase(Username) = LowerCase(TRoomContext(Context).Username.Value) Then Begin
  Status := TRoomContext(Context).Stat.Value;
  If Get_a_Bit(Status, 6) = False Then Begin
    TmpStr := PChar(Cardinal(Packet)+SizeOf(TGroupMessagePacket));
    If Length(TmpStr) > 2048 Then Begin
      TRoomContext(Context).Connection.Disconnect;
      Exit;
    End;
    Room := TRoom(TRoomContext(Context).Room);
    Try
      ForwardToRoomUsers(Username, Room, False, Packet, Packet.BufferSize);
    Finally
      Room := Nil;
    End;
    Sleep(10);
  End;
End;
End;

示例包

TGroupMessagePacket = packed record
    Signature: Word;
    Version: Cardinal;
    DataType: Byte;
    BufferSize: Word;
    RoomCode: Cardinal;
    UserName: array[0..32] of char;
  end;
  PGroupMessagePacket = ^TGroupMessagePacket;

最后这是数据包的发送方式

Procedure SendMessagePacket(Msg: string);
Var Packet: PGroupMessagePacket;
    PacketSize: Cardinal;
Begin
  PacketSize := SizeOf(TGroupMessagePacket)+Length(Msg)+1;
  GetMem(Packet,PacketSize);
  Try
    ZeroMemory(Packet,PacketSize);
    Packet.Signature := PACKET_SIGNATURE;
    Packet.Version := PACKET_VERSION;
    Packet.DataType := pdtGroupMessage;
    Packet.BufferSize := PacketSize;
    Packet.RoomCode := RoomCode;
    StrCopy(Packet.UserName,PChar(MainForm.MyNickName));
    StrCopy(PChar(Cardinal(Packet)+SizeOf(TGroupMessagePacket)),PChar(Msg));
    PByte(Cardinal(Packet)+PacketSize-1)^ := 0;
    SendBuffer(Packet^,PacketSize);
  Finally
    FreeMem(Packet);
  End;
End;

这是一个巨大的代码，任何人都可以看，我知道没有人有那么多时间免费查找，但如果有人帮助我，我会非常感激，我无法弄清楚错误是什么是和它已经几个月，我尝试了AqTime但仍然没有运气

由于

Answer 1

由于您说泄漏只出现在实时服务器上，因此请查看FastMM泄漏报告到日志文件中。看看是否可以构建具有泄漏报告的服务器到日志文件中并使其保持运行。

如果您创建并释放大量对象，可能会发现一个有用的技巧。为每个对象添加一个带有它名称的字符串。现在运行服务器很长一段时间。当你得到大量的内存泄露时，得到一个大的memdump，其中95％充满了泄漏的对象。检查转储中的几个随机位置，看看形成它的对象。

德尔福：内存泄漏

1 个答案: