我一直被这个问题困扰，我不知道我做错了什么。我正在使用 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 事件
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;
从 OnExecute 事件调用的 ProcessPacket 和相关函数
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 但还是没有运气
谢谢