function ReceiveText: string; virtual; function TCustomWinSocket.ReceiveText: string; begin if ReceiveLength > 0 then begin SetLength(Result, ReceiveLength); ReceiveBuf(Result[1], Length(Result)); end else Result := ''; end;
function TServerClientWinSocket.ReceiveLength: Integer; begin Result := FStream.Position; end; function TServerClientWinSocket.ReceiveBuf(var Buf; Count: Integer): Integer; var P, Len: Integer; begin Lock; try if FStream.Position >= Count then begin P := FStream.Position - Count; FStream.Position := P; Len := Count; end else begin P := 0; Len := FStream.Position; FStream.Position := P; end;
Result := FStream.Read(Buf, Len); if FStream.Position = FStream.Size then begin //大于4K就放掉重新分配内存,否则,只是将指针移动到头部 if FStream.Size > 4096 then FStream.Clear else FStream.Position := 0; end else begin FStream.Position := P + (Len - Result); end; finally UnLock; end; end;
新修改： TCustomWinSocket类添加了 function ReceiveText: string; virtual; function TCustomWinSocket.ReceiveText: string; begin if ReceiveLength > 0 then begin SetLength(Result, ReceiveLength); ReceiveBuf(Result[1], Length(Result)); end else Result := ''; end;
function TServerClientWinSocket.ReceiveLength: Integer; begin Result := FStream.Position; end; function TServerClientWinSocket.ReceiveBuf(var Buf; Count: Integer): Integer; var P1: Integer; PS, PD: Pointer; begin Lock; try P1 := FStream.Position; FStream.Seek(0, soBeginning); FStream.ReadBuffer(Buf, Count); if FStream.Position = P1 then begin {大于4K就放掉重新分配内存,否则,只是将指针移动到头部} if FStream.Size > 4096 then FStream.Clear else FStream.Seek(0, soBeginning); end else if FStream.Position < P1 then begin PS := Pointer(Longint(FStream.Memory) + FStream.Position); Move(PS^, FStream.Memory^, P1 - FStream.Position); FStream.Position := P1 - FStream.Position; end; finally UnLock; end; end;
FastMM4发现内存泄漏： ----------2009/6/7 15:52:36---------- FastMM has detected an error during a free block scan operation. FastMM detected that a block has been modified after being freed.
The previous block size was: 4127
This block was previously allocated by thread 0xF84, and the stack trace (return addresses) at the time was: 402D48 456CA4 4583CA 44D09F 45475C 4586A4 7C82F23B [Unknown function at ProcessIdToSessionId]
The allocation number was: 527
The block was previously freed by thread 0xF84, and the stack trace (return addresses) at the time was: 402D73
The current thread ID is 0xF84, and the stack trace (return addresses) leading to this error is: 40B826 40B86E 4041FF 4044BE 7C82F23B [Unknown function at ProcessIdToSessionId]
function TServerClientWinSocket.WorkBlock(var Block: PBlock; Transfered: DWORD): DWORD; var ErrCode: Integer; Flag, BytesSend: Cardinal; begin Result := RESPONSE_SUCCESS; with Block^.Data do try case Block^.Data.Event of seRead: begin {利用内存流来保存收到的数据,有可能造成频繁的内存重新分配,可以改进} Lock; FStream.Clear; //<<---接收到流前先清空原内容， FStream.Write(Buffer, Transfered); UnLock; Self.Event(Self, seRead); if not PrepareRecv(Block) then Result := RESPONSE_FAIL; end; seWrite: begin // Self.Event(Self, seWrite); Dec(wsaBuffer.len, Transfered); if wsaBuffer.len <= 0 then begin { 发送完成，将Block置空，返回到FBlock的可使用的缓区中 } Block.Data.IsUse := False; Block := nil; end else begin { 数据还没发送完成，继续发送 } Flag := 0; Inc(wsaBuffer.buf, Transfered); FillChar(Overlapped, SizeOf(Overlapped), 0); if SOCKET_ERROR = WSASend(FSocket, @wsaBuffer, 1, BytesSend, Flag, @Overlapped, nil) then begin ErrCode := WSAGetLastError; if ErrCode <> ERROR_IO_PENDING then Error(Self, eeSend, ErrCode); end; end; end; end; except Result := RESPONSE_FAIL; end; end;
