Problemy z wyciekiem pamięci z wywołaniem Windows API - Delphi

Question

Pisałem program, który idealnie będzie działał na serwerze w tle, nigdy się nie zamykając - dlatego ważne jest, aby wszelkie wycieki pamięci nie istniały. Mój program polega na pobieraniu informacji o sesji na żywo przy użyciu interfejsu Windows Terminal Services API (wtsapi32.dll), a ponieważ informacja musi być aktywna, funkcja jest uruchamiana co kilka sekund. Odkryłem, że wywołanie funkcji WTSEnumerateSessionsEx doprowadziło do dość znacznego wycieku pamięci . Wydaje się, że wywołanie WTSFreeMemoryEx zgodnie z instrukcjami zawartymi w dokumentacji MSDN wydaje się nie mieć wpływu, ale nie otrzymuję komunikatów o błędach z żadnego z wywołań.

Podsumowując: problem nie jest w wykonaniu WTSEnumerateSessionsEx, ponieważ zwracane są prawidłowe dane; pamięć po prostu nie jest uwalniana, a to prowadzi do problemów, które pozostawia się do działania przez dłuższy czas.

Obecnie rozwiązaniem krótkoterminowym jest ponowne uruchomienie procesu, gdy pamięć wykorzystywana przekroczy próg, jednak nie wydaje się to być zadowalającym rozwiązaniem, a poprawienie tego wycieku byłoby najbardziej pożądane.

Typy wyliczeń zostały pobrane bezpośrednio z dokumentacji Microsoft MSDN.

Załączony jest odpowiedni plik źródłowy.

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. 

Oto minimalny SSCCE, który demonstruje problem. Po uruchomieniu tego programu wyczerpuje on dostępną pamięć w krótkim czasie.

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

Podsumowując ścieżkę komentarza, myślę, że jest błąd w kodzie biblioteki WTS, który dotyka funkcji WTSEnumerateSessionsEx i WTSFreeMemoryEx. SSCCE, które dodałem do tego pytania, daje dość wyraźną demonstrację tego.

Tak, opcje, aby obejść winy wydaje się być:

1. zadzwonić Tylko WTSEnumerateSessionsEx kiedy otrzymywać powiadomienia, że ​​sesja jest tworzony lub zniszczone. To zminimalizowałoby liczbę twoich połączeń. Wciąż będziesz mieć wyciek, ale podejrzewam, że zanim problemy napotkają, minie dużo czasu.
2. Przełącz na WTSEnumerateSessions, a następnie zadzwoń pod numer WTSQuerySessionInformation, aby uzyskać dodatkowe informacje, których potrzebujesz. Z moich prób, WTSEnumerateSessions wydaje się nie być dotknięty przez ten sam problem, co WTSEnumerateSessionsEx.

Answer 2

stworzyłem tej samej próbce 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; 
} 

Ja obserwując takie samo zachowanie w Menedżerze zadań i mimo Task Manager nie jest narzędziem do śledzenia pamięci przecieki to zachowanie jest wyraźnie przeciek i wygląda na to, że to błąd. Zdarza się zarówno w kompilacji x86, jak i x64 (x64 używa wersji WtsApi32.dll w wersji x64).