Detecting TS sessions now requires extra effort

delphi package - automated exception handling
Post Reply
zunzster
Posts: 58
Joined: Wed Oct 29, 2008 3:43 am

Detecting TS sessions now requires extra effort

Post by zunzster »

We've recently discovered that using GetSystemMetrics to detect Terminal Services remote sessions is no longer sufficient per Microsoft. <sigh>
https://docs.microsoft.com/en-us/window ... nvironment
It's been this way since Windows 8/Server 2012 when RemoteFX was introduced but maybe it's just taken a while for our sites to commonly have RemoteFX capable CPUs and GPUs.

Just in case anyone else is tripped up by not realizing your app is running under TS when it actually is, you might want to modify madExcept.GetTSClientName as follows:

Code: Select all

function GetTSClientName : UnicodeString;
const
    SM_REMOTESESSION = $1000;
    STerminalServerKey = 'System\CurrentControlSet\Control\Terminal Server';
    SGlassSessionID = 'GlassSessionID';
var dll : HMODULE;
    buf : pointer;
    len : dword;
    qsi : function (server: THandle; session, infoClass: dword; var buf: pointer; var len: dword) : bool; stdcall;
    fm  : procedure (buf: pointer); stdcall;
    ProcessIdToSessionId: function(dwProcessId: DWORD; pSessionId: DWORD): BOOL; stdcall;
    SessionID: Integer;
    HK: HKEY;
    GlassSessionID: Integer;
begin
  result := '';
  SessionID := 0;
  try
  dll := GetModuleHandle('kernel32');
  if dll <> 0 then
    begin
      ProcessIdToSessionId := GetProcAddress(dll, 'ProcessIdToSessionId');
      if Assigned(ProcessIdToSessionId) then
        ProcessIdToSessionId(GetCurrentProcessId(), DWORD(@SessionID));
    end;
    Len := SizeOf(Integer);
    GlassSessionID := 0;
    if RegOpenKeyEx(HKEY_LOCAL_MACHINE, STerminalServerKey, 0,
      KEY_QUERY_VALUE, HK) = ERROR_SUCCESS then
      begin
        RegQueryValueEx(HK, PChar(SGlassSessionID), nil, nil, @GlassSessionID, @Len);
        RegCloseKey(HK)
      end;

    if (GetVersion and $80000000 = 0) and ((GetSystemMetrics(SM_REMOTESESSION) <> 0) or
      (SessionID <> GlassSessionID)) then begin
      dll := LoadLibrary('wtsapi32.dll');
      qsi := GetProcAddress(dll, 'WTSQuerySessionInformationW');
      fm  := GetProcAddress(dll, 'WTSFreeMemory');
      if (@qsi <> nil) and (@fm <> nil) then begin
        if qsi(0, dword(-1), 10, buf, len) and (len > 1) then begin
          SetString(result, PWideChar(buf), len div 2 - 1);
          result := PWideChar(result);
          fm(buf);
        end;
      end;
    end;
  except end;
end;
madshi
Site Admin
Posts: 10764
Joined: Sun Mar 21, 2004 5:25 pm

Re: Detecting TS sessions now requires extra effort

Post by madshi »

Argh, Microsoft makings things harder for no (good) reason, once more. Thanks for letting me know.
madshi
Site Admin
Posts: 10764
Joined: Sun Mar 21, 2004 5:25 pm

Re: Detecting TS sessions now requires extra effort

Post by madshi »

P.S: Your "ProcessIdToSessionId" definition is not correct. The 2nd parameter needs to be a pointer to a DWORD, or a "var" DWORD. Otherwise it may crash in 64bit.
zunzster
Posts: 58
Joined: Wed Oct 29, 2008 3:43 am

Re: Detecting TS sessions now requires extra effort

Post by zunzster »

Ah yes, not 64-bit safe. Fixed.
Post Reply