这个FastMM4无效指针异常是否是Delphi 5中FastMM的一个漏洞？

Question

在 Delphi 5 中，启用 FastMM 后，在下面的“最小可重现代码”中调用 FreeMem 将触发 “Invalid Pointer Exception” 异常。

program Project1;
{$APPTYPE CONSOLE}

uses
  FastMM4,
  SysUtils,
  Windows;

procedure Main;
var
    token: THandle;
    returnLength: Cardinal;
    p: Pointer;
begin
    OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, {out}token);

    //Get the size of the buffer required.
    //It's normally going to be 38 bytes. We'll use 16KB to eliminate the possibility of buffer overrun
//  Windows.GetTokenInformation(token, TokenUser, nil, 0, {var}returnLength);
    p := GetMemory(16384); //GetMemory(returnLength);

    Windows.GetTokenInformation(token, TokenUser, p, 1024, {var}returnLength);

    FreeMem({var}p); //FreeMem is the documented way to free memory allocated with GetMemory.
//  FreeMemory(p); //FreeMemory is the C++ compatible version of FreeMem.
end;

begin
    Main;
end.

调用 FreeMme 函数失败，出现 EInvalidPointerException 错误：

FreeMem({var}p); //error

如果发生以下情况，错误将停止发生：

• 停止使用FastMM4
• 停止调用GetTokenInformation
• 调用FreeMemory （而不是FreeMem）

我在全新安装的Delphi 5和全新安装的Windows 7机器上复现了此错误。FastMM4 v4.992。

• Delphi 7中不会出现此错误
• Delphi XE6中不会出现此错误

只有：

• 使用FastMM4的Delphi 5

解决方法

如果这是FastMM4的错误，则可以解决它。而不是调用：

• GetMemory
• FreeMem

我可以手动另一种方式分配缓冲区：

• SetLength（buffer，cb）
• SetLength（buffer，0）

如果这不是FastMM4的错误，我想修复上述代码。

使用FreeMemory而不是FreeMem不会触发错误

我认为FastMM接管了内存管理，这就是为什么我惊讶地发现：

• FreeMem({var}p); 失败
• FreeMemory(p); 正常工作

内部实现中，FreeMem是作为调用内存管理器的调用来实现的。在这种情况下，内存管理器（FastMM）返回非零值，导致调用reInvalidPtr：

System.pas

procedure _FreeMem;
asm
        TEST    EAX,EAX
        JE      @@1
        CALL    MemoryManager.FreeMem
        OR      EAX,EAX
        JNE     @@2
@@1:    RET
@@2:    MOV     AL,reInvalidPtr
        JMP     Error
end;

实现 MemoryManager.FreeMem 的过程如下：

FastMM4.pas

function FastFreeMem(APointer: Pointer);

FreeMem接受var指针，而FreeMemory接受指针

FreeMemory的实现为:

System.pas:

function FreeMemory(P: Pointer): Integer; cdecl;
begin
  if P = nil then
    Result := 0
  else
    Result := SysFreeMem(P);
end;

而且 SysFreeMem 的实现在以下文件中:

GetMem.inc:

function SysFreeMem(p: Pointer): Integer;
// Deallocate memory block.
label
  abort;
var
  u, n : PUsed;
  f : PFree;
  prevSize, nextSize, size : Integer;
begin
  heapErrorCode := cHeapOk;

  if not initialized and not InitAllocator then begin
    heapErrorCode := cCantInit;
    result := cCantInit;
    exit;
  end;

  try
    if IsMultiThread then EnterCriticalSection(heapLock);

    u := p;
    u := PUsed(PChar(u) - sizeof(TUsed)); { inv: u = address of allocated block being freed }
    size := u.sizeFlags;
    { inv: size = SET(block size) + [block flags] }

    { validate that the interpretation of this block as a used block is correct }
    if (size and cThisUsedFlag) = 0 then begin
      heapErrorCode := cBadUsedBlock;
      goto abort;
    end;

    { inv: the memory block addressed by 'u' and 'p' is an allocated block }

    Dec(AllocMemCount);
    Dec(AllocMemSize,size and not cFlags - sizeof(TUsed));

    if (size and cPrevFreeFlag) <> 0 then begin
      { previous block is free, coalesce }
      prevSize := PFree(PChar(u)-sizeof(TFree)).size;
      if (prevSize < sizeof(TFree)) or ((prevSize and cFlags) <> 0) then begin
        heapErrorCode := cBadPrevBlock;
        goto abort;
      end;

      f := PFree(PChar(u) - prevSize);
      if f^.size <> prevSize then begin
        heapErrorCode := cBadPrevBlock;
        goto abort;
      end;

      inc(size, prevSize);
      u := PUsed(f);
      DeleteFree(f);
    end;

    size := size and not cFlags;
    { inv: size = block size }

    n := PUsed(PChar(u) + size);
    { inv: n = block following the block to free }

    if PChar(n) = curAlloc then begin
      { inv: u = last block allocated }
      dec(curAlloc, size);
      inc(remBytes, size);
      if remBytes > cDecommitMin then
        FreeCurAlloc;
      result := cHeapOk;
      exit;
    end;

    if (n.sizeFlags and cThisUsedFlag) <> 0 then begin
      { inv: n is a used block }
      if (n.sizeFlags and not cFlags) < sizeof(TUsed) then begin
        heapErrorCode := cBadNextBlock;
        goto abort;
      end;
      n.sizeFlags := n.sizeFlags or cPrevFreeFlag
    end else begin
      { inv: block u & n are both free; coalesce }
      f := PFree(n);
      if (f.next = nil) or (f.prev = nil) or (f.size < sizeof(TFree)) then begin
        heapErrorCode := cBadNextBlock;
        goto abort;
      end;
      nextSize := f.size;
      inc(size, nextSize);
      DeleteFree(f);
      { inv: last block (which was free) is not on free list }
    end;

    InsertFree(u, size);
abort:
    result := heapErrorCode;
  finally
    if IsMultiThread then LeaveCriticalSection(heapLock);
  end;
end;

因此，FreeMemory不会触发错误是有道理的；FreeMemory并未被内存管理器所占用。我猜这就是为什么FreeMemory不是GetMemory的文档对应项：

- Ian Boyd

---

我不知道你从哪里得到的FreeMem是使用GetMemory分配内存后释放的文档规定方式，因为它不是。要丢弃缓冲区，请使用FreeMemory. 如果你使用GetMemory分配内存，则应使用FreeMemory来释放它。如果你使用GetMem分配内存，则应使用FreeMem来释放它。 - Ken White

@KenWhite 我从文档中获取了它（添加了链接、存档和截图）。 - Ian Boyd

@zed 那就解释了。在 Delphi 5 中，GetMemory 是一个硬编码的内部实现，存储在一个 .inc 文件中。从 Delphi 7 开始，GetMemory 和 FreeMemory 被重新设计为调用 MemoryManager，而不是内部硬编码的内存管理器。 - Ian Boyd

需要使用try/finally来防止泄漏的需求意味着你实际上并没有编写你所描述的那种代码。你无法将GetMemory的返回值传递给GetTokenInformation，因为你需要插入一个try。所以这对我来说毫无意义。 - David Heffernan

批评问题与能够评论并提供正确答案无关。声誉是通过后者获得的。 - Sertac Akyuz

Answer 1

FreeMem不是释放使用GetMemory分配内存的正式方式 - 这显然是旧文档中的错误，已经得到更正。 根据System.GetMemory的文档（强调），GetMemory分配一个内存块。

GetMemory分配一个内存块。

GetMemory在堆上为给定大小的块分配内存，并返回此内存的地址。 分配的缓冲区的字节未设置为零。 要释放缓冲区，请使用FreeMemory。 如果没有足够的内存可用于分配块，则会引发EOutOfMemory异常。

如果使用GetMem分配内存，请使用FreeMem。如果使用GetMemory进行分配，则使用FreeMemory。

- Ken White

---

需要注意的是，在 Delphi 5 中，GetMemory 和 FreeMemory 都没有使用注册的 MemoryManager。如果您想使用自定义的内存管理器（例如 FastMM），则任何对 GetMemory 或 FreeMemory 的调用都会绕过已注册的内存管理器。到了 Delphi 7，这种情况发生了变化，GetMem/FreeMem 和 GetMemory/FreeMemory 都会使用已安装的内存管理器。但如果您仍在使用 Delphi 5，则必须避免使用 GetMemory/FreeMemory。 - Ian Boyd