Detecting TS sessions now requires extra effort

delphi package - automated exception handling

Detecting TS sessions now requires extra effort

Postby zunzster » Sun Nov 03, 2019 9:47 pm

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;
zunzster
 
Posts: 51
Joined: Wed Oct 29, 2008 3:43 am

Re: Detecting TS sessions now requires extra effort

Postby madshi » Wed Nov 13, 2019 9:43 pm

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

Re: Detecting TS sessions now requires extra effort

Postby madshi » Wed Nov 13, 2019 9:50 pm

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.
madshi
Site Admin
 
Posts: 10098
Joined: Sun Mar 21, 2004 5:25 pm

Re: Detecting TS sessions now requires extra effort

Postby zunzster » Mon Nov 25, 2019 2:41 am

Ah yes, not 64-bit safe. Fixed.
zunzster
 
Posts: 51
Joined: Wed Oct 29, 2008 3:43 am


Return to madExcept

Who is online

Users browsing this forum: No registered users and 6 guests

cron