Sự cố rò rỉ bộ nhớ với lệnh gọi API Windows - Delphi

Question

Tôi đã viết chương trình lý tưởng sẽ chạy trên máy chủ ở chế độ nền mà không bao giờ đóng - do đó điều quan trọng là mọi rò rỉ bộ nhớ đều không tồn tại. Chương trình của tôi liên quan đến việc lấy thông tin phiên trực tiếp bằng cách sử dụng API dịch vụ đầu cuối của Windows (wtsapi32.dll) và vì thông tin phải trực tiếp, chức năng đang được chạy vài giây một lần, tôi thấy rằng chức năng WTSEnumerateSessionsEx đã dẫn đến rò rỉ bộ nhớ khá lớn . Dường như cuộc gọi đến WTSFreeMemoryEx như được hướng dẫn trong tài liệu MSDN dường như không có tác động nhưng tôi không nhận được thông báo lỗi từ một trong hai cuộc gọi.

Để tóm tắt: sự cố không được thực thi WTSEnumerateSessionsEx vì dữ liệu hợp lệ được trả về; bộ nhớ chỉ đơn giản là không được giải phóng và điều này dẫn đến các vấn đề khi còn lại để chạy trong thời gian dài.

Hiện tại giải pháp ngắn hạn là khởi động lại quá trình khi bộ nhớ được sử dụng vượt quá ngưỡng tuy nhiên đây không phải là giải pháp thỏa đáng và việc khắc phục sự rò rỉ này là điều mong muốn nhất.

Các kiểu liệt kê đã được lấy trực tiếp từ tài liệu Microsoft MSDN.

Đính kèm là tệp nguồn có liên quan.

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. 

Đây là SSCCE tối thiểu thể hiện sự cố. Khi chương trình này thực hiện, nó sẽ loại bỏ bộ nhớ sẵn có trong thời gian ngắn.

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

Để tóm tắt đường dẫn nhận xét, tôi nghĩ rằng có lỗi trong mã thư viện WTS, điều này ảnh hưởng đến các hàm WTSEnumerateSessionsEx và WTSFreeMemoryEx. SSCCE mà tôi đã thêm vào câu hỏi đưa ra một minh chứng rõ ràng về điều đó.

Vì vậy, lựa chọn của bạn để làm việc xung quanh lỗi sẽ xuất hiện để được:

1. Chỉ gọi WTSEnumerateSessionsEx khi bạn nhận được thông báo rằng một phiên được tạo ra hoặc bị phá hủy. Điều đó sẽ giảm thiểu số lượng cuộc gọi bạn thực hiện. Bạn vẫn còn bị rò rỉ, nhưng tôi nghi ngờ rằng phải mất một thời gian rất lâu trước khi bạn gặp phải vấn đề.
2. Chuyển sang WTSEnumerateSessions và sau đó gọi WTSQuerySessionInformation để nhận thêm bất kỳ thông tin nào bạn cần. Từ các thử nghiệm của tôi, WTSEnumerateSessions sẽ không bị ảnh hưởng bởi cùng một vấn đề như WTSEnumerateSessionsEx.

Answer 2

tôi tạo ra các mẫu tương tự trong 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; 
} 

Tôi quan sát các hành vi tương tự trong Task Manager và mặc dù Task Manager không phải là một công cụ để theo dõi bộ nhớ rò rỉ hành vi này rõ ràng là một sự rò rỉ và nó có vẻ giống như một con bọ. Nó xảy ra cả trong x86 và x64 xây dựng (x64 sử dụng phiên bản x64 của WtsApi32.dll).