windows - 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.

score 2 · Accepted Answer

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;
}

タスクマネージャーで同じ動作を観察しています。タスクマネージャーはメモリリークを追跡するツールではありませんが、この動作は明らかにリークであり、バグのようです。x86 ビルドと x64 ビルドの両方で発生します (x64 は x64 バージョンの WtsApi32.dll を使用します)。

score -1 · Accepted Answer

配列の使用が終了したら、WTSFreeMemoryEx 関数を呼び出して配列を解放します。また、ポインターを NULL に設定する必要があります。 (C) https://docs.microsoft.com/en-us/windows/desktop/api/wtsapi32/nf-wtsapi32-wtsenumeratesessionsexa

windows - Windows API 呼び出しでのメモリ リークの問題 - Delphi

3 に答える 3

Related

Reference

windows - Windows API 呼び出しでのメモリリークの問題 - Delphi