我一直坚持这个问题，我不知道我做错了什么。我正在使用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但仍然没有运气
由于
答案 0 :(得分：2)
由于您说泄漏只出现在实时服务器上，因此请查看FastMM泄漏报告到日志文件中。看看是否可以构建具有泄漏报告的服务器到日志文件中并使其保持运行。
如果您创建并释放大量对象，可能会发现一个有用的技巧。为每个对象添加一个带有它名称的字符串。现在运行服务器很长一段时间。当你得到大量的内存泄露时，得到一个大的memdump，其中95％充满了泄漏的对象。检查转储中的几个随机位置，看看形成它的对象。