将 TJpegImage 分配给 TBitmap 时出现大量软页面错误

Question

我有一个 Delphi 6 Pro 应用程序，用于处理来自流视频服务器的传入 jpeg 帧。该代码可以工作，但我最近注意到它随着时间的推移会产生大量的软页面错误。经过一些调查后，页面错误似乎来自一项特定的图形操作。请注意，所讨论的未压缩位图的大小为 320 x 240 或大约 300 KB，因此这不是由于处理大图像所致。生成的页面错误数量是无法容忍的。一个多小时就可以轻松达到 1000000 个页面错误。

我创建了一个精简的测试用例，它在计时器上执行下面包含的代码，每秒 10 次。当我尝试在 GetBitmap() 方法中将 TJpegImage 分配给 TBitmap 时，似乎会发生页面错误。我知道这一点是因为我注释掉了该行并且不会发生页面错误。 allocate() 会触发 TJpegImage 部分的解压缩操作，因为它将解压缩的位推入 GetBitmap() 返回的新创建的位图中。当我运行 Microsoft 的 pfmon 实用程序（页面错误监视器）时，我收到大量与 RtlFillMemoryUlong 相关的软页面错误错误行，因此它似乎是在内存缓冲区填充操作期间发生的。

一张令人费解的纸条。 pfmon 报告的摘要部分显示了哪个 DLL 导致了哪个页面错误，但在最左列中没有显示任何 DLL 名称。我在另一个系统上尝试过这个，它也发生在那里。

任何人都可以建议修复或解决方法吗？这是代码。请注意，IReceiveBufferForClientSocket 是一个简单的类对象，它在累积缓冲区中保存字节。

function GetBitmap(theJpegImage: TJpegImage): Graphics.TBitmap;
begin
    Result := TBitmap.Create;

    Result.Assign(theJpegImage);
end;

// ---------------------------------------------------------------

procedure processJpegFrame(intfReceiveBuffer: IReceiveBufferForClientSocket);
var
    theBitmap: TBitmap;
    theJpegStream, theBitmapStream: TMemoryStream;
    theJpegImage: TJpegImage;
begin

    theBitmap := nil;
    theJpegImage := TJPEGImage.Create;
    theJpegStream:= TMemoryStream.Create;
    theBitmapStream := TMemoryStream.Create;

    try // 2
        // ************************ BEGIN JPEG FRAME PROCESSING

        // Load the JPEG image from the receive buffer.
        theJpegStream.Size := intfReceiveBuffer.numBytesInBuffer;
        Move(intfReceiveBuffer.bufPtr^, theJpegStream.Memory^, intfReceiveBuffer.numBytesInBuffer);

        theJpegImage.LoadFromStream(theJpegStream);

        // Convert to bitmap.
        theBitmap := GetBitmap(theJpegImage);

    finally
        // Free memory objects.
        if Assigned(theBitmap) then
            theBitmap.Free;
        if Assigned(theJpegImage) then
            theJpegImage.Free;
        if Assigned(theBitmapStream) then
            theBitmapStream.Free;
        if Assigned(theJpegStream) then
            theJpegStream.Free;
    end; // try()
end;

// ---------------------------------------------------------------

procedure TForm1.Timer1Timer(Sender: TObject);
begin
    processJpegFrame(FIntfReceiveBufferForClientSocket);
end;

// ---------------------------------------------------------------

procedure TForm1.FormCreate(Sender: TObject);
var
    S: string;
begin
    FIntfReceiveBufferForClientSocket := TReceiveBufferForClientSocket.Create(1000000);

    S := loadStringFromFile('c:\test.jpg');

    FIntfReceiveBufferForClientSocket.assign(S);
end;

// ---------------------------------------------------------------

谢谢， 罗伯特

Answer 1

听起来您分配和释放的分配不会被内存管理器回收。

使用 fastmm，或者更好，将它们集中起来并自己回收。