Memory leak issues with Windows API call - Delphi

Question

I have been writing a program that ideally will run on a server in the background without ever closing - therefore it is important that any memory leaks are non existent. My program involves retrieving live session information using the Windows Terminal Services API (wtsapi32.dll) and since the information must be live the function is being run every few seconds, I have found that calling the WTSEnumerateSessionsEx function has lead to a fairly sizable memory leak. It seems the call to WTSFreeMemoryEx as instructed in the MSDN documentation seems to have no impact yet I receive no error messages from either call.

To summarize: the problem is not in execution of WTSEnumerateSessionsEx since valid data is returned; the memory is simply not being freed and this leads to problems when left to run for extended periods of time.

Currently the short-term solution has been to restart the process when used memory exceeds a threshold however this doesn't seem to be a satisfactory solution and rectifying this leak would be most desirable.

The enumeration types have been taken directly from the Microsoft MSDN documentation.

Attached is the relevant source file.

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.

Here's is a minimal SSCCE that demonstrates the issue. When this program executes, it exhausts available memory in short time.

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

To summarise the comment trail, I think that there is a fault in the WTS library code, that afflicts the WTSEnumerateSessionsEx and WTSFreeMemoryEx functions. The SSCCE that I added to the question gives a pretty clear demonstration of that.

So, your options to work around the fault would appear to be:

1. Only call WTSEnumerateSessionsEx when you get notified that a session is created or destroyed. That would minimise the number of calls you make. You'd still be left with a leak, but I suspect that it would take a very long time before you encountered problems.
2. Switch to WTSEnumerateSessions and then call WTSQuerySessionInformation to obtain any extra information that you need. From my trials, WTSEnumerateSessions would appear not to be afflicted by the same problem as WTSEnumerateSessionsEx.