使用Windows API调用时出现内存泄漏问题 - Delphi

Question

我正在编写一个程序，理想情况下它将在服务器上后台运行而不关闭 - 因此非常重要的一点是任何内存泄漏都不存在。我的程序涉及使用Windows终端服务API（wtsapi32.dll）检索实时会话信息，由于信息必须是实时的，因此该函数每隔几秒钟运行一次，我发现调用WTSEnumerateSessionsEx函数会导致相当大的内存泄漏。似乎根据MSDN文档中的指示调用WTSFreeMemoryEx没有任何影响，但我对这两个调用都没有收到错误消息。

总之：问题不在于执行WTSEnumerateSessionsEx，因为返回了有效数据；内存只是没有被释放，在长时间运行时会导致问题。

目前的短期解决方案是当使用的内存超过阈值时重新启动进程，但这似乎并不是一个令人满意的解决方案，纠正这个泄漏将是最理想的解决方案。

枚举类型直接取自Microsoft MSDN文档。

附上相关源文件。

unit WtsAPI32;

interface

uses Windows, Classes, Dialogs, SysUtils, StrUtils;

const
  WTS_CURRENT_SERVER_HANDLE = 0;

type
  WTS_CONNECTSTATE_CLASS = (WTSActive, WTSConnected, WTSConnectQuery,
    WTSShadow, WTSDisconnected, WTSIdle, WTSListen, WTSReset, WTSDown,
    WTSInit);

type
  WTS_TYPE_CLASS = (WTSTypeProcessInfoLevel0, WTSTypeProcessInfoLevel1,
    WTSTypeSessionInfoLevel1);

type
  WTS_SESSION_INFO_1 = record
    ExecEnvId: DWord;
    State: WTS_CONNECTSTATE_CLASS;
    SessionId: DWord;
    pSessionName: LPtStr;
    pHostName: LPtStr;
    pUserName: LPtStr;
    pDomainName: LPtStr;
    pFarmName: LPtStr;
  end;

type
  TSessionInfoEx = record
    ExecEnvId: DWord;
    State: WTS_CONNECTSTATE_CLASS;
    SessionId: DWord;
    pSessionName: string;
    pHostName: string;
    pUserName: string;
    pDomainName: string;
    pFarmName: string;
  end;

  TSessions = array of TSessionInfoEx;

function FreeMemoryEx(WTSTypeClass: WTS_TYPE_CLASS; pMemory: Pointer;
  NumberOfEntries: Integer): BOOL; stdcall;
external 'wtsapi32.dll' name 'WTSFreeMemoryExW';

function FreeMemory(pMemory: Pointer): DWord; stdcall;
external 'wtsapi32.dll' name 'WTSFreeMemory';

function EnumerateSessionsEx(hServer: THandle; var pLevel: DWord;
  Filter: DWord; var ppSessionInfo: Pointer; var pCount: DWord): BOOL;
  stdcall; external 'wtsapi32.dll' name 'WTSEnumerateSessionsExW';

function EnumerateSessions(var Sessions: TSessions): Boolean;

implementation

function EnumerateSessions(var Sessions: TSessions): Boolean;
type
   TSessionInfoExArr = array[0..2000 div SizeOf(WTS_SESSION_INFO_1)] of WTS_SESSION_INFO_1;
var
  ppSessionInfo: Pointer;
  pCount: DWord;
  hServer: THandle;
  level: DWord;
  i: Integer;
  ErrCode: Integer;
  Return: DWord;
begin
  pCount := 0;
  level := 1;
  hServer := WTS_CURRENT_SERVER_HANDLE;
  ppSessionInfo := NIL;
  if not EnumerateSessionsEx(hServer, level, 0, ppSessionInfo, pCount) then
  begin
   ErrCode := GetLastError;
   ShowMessage('Error in EnumerateSessionsEx - Code: ' + IntToStr(ErrCode)
        + ' Message: ' + SysErrorMessage(ErrCode));
  en
  else
  begin
    SetLength(Sessions, pCount);
    for i := 0 to pCount - 1 do
    begin
      Sessions[i].ExecEnvId := TSessionInfoExArr(ppSessionInfo^)[i].ExecEnvId;
      Sessions[i].State := TSessionInfoExArr(ppSessionInfo^)[i].State;
      Sessions[i].SessionId := TSessionInfoExArr(ppSessionInfo^)[i].SessionId;
      Sessions[i].pSessionName := WideCharToString
        (TSessionInfoExArr(ppSessionInfo^)[i].pSessionName);
      Sessions[i].pHostName := WideCharToString
        (TSessionInfoExArr(ppSessionInfo^)[i].pHostName);
      Sessions[i].pUserName := WideCharToString
        (TSessionInfoExArr(ppSessionInfo^)[i].pUserName);
      Sessions[i].pDomainName := WideCharToString
        (TSessionInfoExArr(ppSessionInfo^)[i].pDomainName);
      Sessions[i].pFarmName := WideCharToString
        (TSessionInfoExArr(ppSessionInfo^)[i].pFarmName);
    end;

    if not FreeBufferEx(WTSTypeSessionInfoLevel1, ppSessionInfo, pCount);
      begin
      ErrCode := GetLastError;
      ShowMessage('Error in EnumerateSessionsEx - Code: ' + IntToStr(ErrCode)
           + ' Message: ' + SysErrorMessage(ErrCode));
      end;
      ppSessionInfo := nil;
  end;

end;

end.

这里是一个最小化的 SSCCE 代码，演示了这个问题。当程序执行时，它很快地耗尽了可用内存。

program SO17839270;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

const
  WTS_CURRENT_SERVER_HANDLE = 0;

type
  WTS_TYPE_CLASS = (WTSTypeProcessInfoLevel0, WTSTypeProcessInfoLevel1,
    WTSTypeSessionInfoLevel1);

function WTSEnumerateSessionsEx(hServer: THandle; var pLevel: DWORD;
  Filter: DWORD; var ppSessionInfo: Pointer; var pCount: DWORD): BOOL; stdcall;
  external 'wtsapi32.dll' name 'WTSEnumerateSessionsExW';

function WTSFreeMemoryEx(WTSTypeClass: WTS_TYPE_CLASS; pMemory: Pointer;
  NumberOfEntries: Integer): BOOL; stdcall;
  external 'wtsapi32.dll' name 'WTSFreeMemoryExW';

procedure EnumerateSessionsEx;
var
  ppSessionInfo: Pointer;
  pCount: DWORD;
  level: DWORD;
begin
  level := 1;
  if not WTSEnumerateSessionsEx(WTS_CURRENT_SERVER_HANDLE, level, 0,
    ppSessionInfo, pCount) then
    RaiseLastOSError;
  if not WTSFreeMemoryEx(WTSTypeSessionInfoLevel1, ppSessionInfo, pCount) then
    RaiseLastOSError;
end;

begin
  while True do
    EnumerateSessionsEx;
end.

- tjenks

---

请注意，您的错误检查是错误的。只有在函数调用失败时才调用GetLastError。您必须检查函数返回值。 - David Heffernan

任务管理器不是一个有效的内存泄漏检测器。你怎么知道 WTS 是问题所在？能否提供一个演示该问题的 SSCCE（简短、自成体系、精简的可运行代码示例）？ - David Heffernan

问题在于，应用程序即使在您释放内存时选择不将内存返回给系统。我并不是说您没有泄漏。只是您的诊断不够精确。 - David Heffernan

我有一个40行的SSCCE，我同意代码泄漏。一个解决方法是只在收到新会话创建通知时枚举会话。 - David Heffernan

好的，我添加了一个更清晰地说明问题并删除所有可能混淆因素的SSCCE。我注意到WTSEnumerateSessions似乎没有任何问题。我不知道你是否可以使用它。 - David Heffernan

Answer 1

总结评论记录，我认为WTS库代码存在故障，影响了WTSEnumerateSessionsEx和WTSFreeMemoryEx函数。我在问题中添加的SSCCE演示了这一点。

因此，你可以采取以下解决故障的措施：

1. 仅在收到会话创建或销毁通知时调用WTSEnumerateSessionsEx。这将最小化你所做的调用次数。但是，你仍然会面临泄漏问题，但我认为在遇到问题之前需要很长时间。 2. 切换到WTSEnumerateSessions，然后调用WTSQuerySessionInformation获取所需的任何额外信息。从我的试验来看，WTSEnumerateSessions似乎没有像WTSEnumerateSessionsEx那样受到同样的问题的影响。

- David Heffernan

Answer 2

我在MSVC中创建了相同的示例：

#include <Windows.h>
#include <WtsApi32.h>
#pragma comment(lib, "wtsapi32")

int _tmain(int argc, _TCHAR* argv[])
{
    DWORD Level = 1;
    PWTS_SESSION_INFO_1 pSessionInfo;
    DWORD Count = 0;
    BOOL bRes;
    while (WTSEnumerateSessionsEx(WTS_CURRENT_SERVER_HANDLE, &Level, 0, &pSessionInfo, &Count))
    {
        if (!WTSFreeMemoryEx(WTSTypeSessionInfoLevel1, pSessionInfo, Count))
        {
            break;
        }
    }

    return 0;
}

我在任务管理器中观察到相同的行为，尽管任务管理器不是跟踪内存泄漏的工具，但这种行为显然是一种泄漏，看起来像是一个bug。它发生在x86和x64版本中（x64使用WtsApi32.dll的x64版本）。

- Remko

---

当我在Windows 10 Pro（版本2004）64位上运行此代码时，我没有看到任何内存泄漏的迹象。我怀疑微软已经在更新的Windows版本中修复了这个错误。 - Simon Kissane

Answer 3

当你使用完数组后，通过调用WTSFreeMemoryEx函数来释放它。你还应该将指针设置为NULL。 (C) https://learn.microsoft.com/en-us/windows/desktop/api/wtsapi32/nf-wtsapi32-wtsenumeratesessionsexa

- guest

---

我在您提供的文档页面中没有看到任何关于“NULL”的提及。此外，即使我加入了您的建议并运行了问题末尾的测试程序，也不会有任何区别。您也可以这样做。 - Sertac Akyuz

请问您能否解释一下将指针设置为NULL的目的是什么？ - Kingsley

https://learn.microsoft.com/en-us/windows/desktop/api/wtsapi32/nf-wtsapi32-wtsenumeratesessionsexa - guest