windows - Windows API 调用的内存泄漏问题 - Delphi

Question

我一直在编写一个程序，理想情况下它将在后台的服务器上运行而不会关闭 - 因此不存在任何内存泄漏很重要。我的程序涉及使用 Windows 终端服务 API (wtsapi32.dll) 检索实时 session 信息，并且由于信息必须是实时的，该函数每隔几秒运行一次，我发现调用 WTSEnumerateSessionsEx 函数具有导致相当大的内存泄漏。似乎按照 MSDN 文档中的说明调用 WTSFreeMemoryEx 似乎没有任何影响，但我没有收到任何来自这两个调用的错误消息。

总而言之:问题不在于执行WTSEnumerateSessionsEx，因为返回了有效数据；内 stub 本没有被释放，这会导致长时间运行时出现问题。

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

枚举类型直接取自 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.

Answer 1

总结一下评论线索，我认为 WTS 库代码中存在一个错误，它会影响 WTSEnumerateSessionsEx 和 WTSFreeMemoryEx 函数。我添加到问题中的 SSCCE 非常清楚地证明了这一点。

因此，您解决该错误的选项似乎是:

1. 只有在收到创建或销毁 session 的通知时才调用 WTSEnumerateSessionsEx。这将最大限度地减少您调用的电话数量。您仍然会遇到泄漏，但我怀疑您需要很长时间才能遇到问题。
2. 切换到 WTSEnumerateSessions，然后调用 WTSQuerySessionInformation 以获取您需要的任何额外信息。根据我的试验，WTSEnumerateSessions 似乎不会受到与 WTSEnumerateSessionsEx 相同的问题的困扰。