Delphi: Утечка памяти

Question

Я застрял с этой проблемой, как навсегда, я не знаю, что я делаю неправильно. Я использую indy10 для сервера обмена сообщениями, теперь он отлично работает на какое-то время и, похоже, не создает никаких отчетов об утечке, но когда я запускаю сервер в реальном времени, а количество пользователей увеличивается, мой сервер начинает питаться памятью, он ест до 500 МБ в день. Я не знаю, будет ли у кого-нибудь здесь время, чтобы прочитать код и указать, что я делаю неправильно, я схожу с ума из-за этой проблемы. любая помощь будет действительно оценена. Я отправляю код для того, как я обрабатываю данные.

Класс для 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; 

ОпЕхесиого Событие

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 & функции, связанные с прозванный 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% заполнен просочившимися объектами. Осмотрите несколько случайных мест в дампе и посмотрите, какие объекты сформировали его.