[fpc-pascal] GetAppConfigDir(False) in a Citrix environment

[Bart]

On Wed, Jul 4, 2018 at 12:18 AM, Graeme Geldenhuys
<mailinglists at geldenhuys.co.uk> wrote:

> I haven't had time to look at that job at work yet, but it's on my todo
> list and should be done in the next week. I don't mind sharing the solution.

This is the easy part:

const
  WTS_CURRENT_SERVER_HANDLE = DWORD(0);
  WTS_CURRENT_SESSION = DWORD(-1);
  WTS_PROTOCOL_TYPE_CONSOLE = 0;
  WTS_SESSION_TYPE_ICA = 1;
  WTS_SESSION_TYPE_RDP = 2;

type
  WTS_INFO_CLASS = (
  WTSInitialProgram      ,
  WTSApplicationName     ,
  WTSWorkingDirectory    ,
  WTSOEMId               ,
  WTSSessionId           ,
  WTSUserName            ,
  WTSWinStationName      ,
  WTSDomainName          ,
  WTSConnectState        ,
  WTSClientBuildNumber   ,
  WTSClientName          ,
  WTSClientDirectory     ,
  WTSClientProductId     ,
  WTSClientHardwareId    ,
  WTSClientAddress       ,
  WTSClientDisplay       ,
  WTSClientProtocolType  ,
  WTSIdleTime            ,
  WTSLogonTime           ,
  WTSIncomingBytes       ,
  WTSOutgoingBytes       ,
  WTSIncomingFrames      ,
  WTSOutgoingFrames      ,
  WTSClientInfo          ,
  WTSSessionInfo         ,
  WTSSessionInfoEx       ,
  WTSConfigInfo          ,
  WTSValidationInfo      ,
  WTSSessionAddressV4    ,
  WTSIsRemoteSession);



function WTSQuerySessionInformationA(hServer: HANDLE;
  SessionId: DWORD;
  WTSInfoClass: WTS_INFO_CLASS;
  var ppBuffer: LPTSTR;
  var pBytesReturned: DWORD): BOOL; stdcall; external 'wtsapi32.dll'
name 'WTSQuerySessionInformationA';

procedure WTSFreeMemory(pMemory: Pointer); stdcall; external
'wtsapi32.dll'name 'WTSFreeMemory';

function WTSGetSessionType: Word;
var
  pBuf: Pointer;
  pBytesReturned: DWORD;
begin
  Result := Word(-1);
  pBuf := nil;
  pBytesReturned := 0;
  if not WTSQuerySessionInformationA(WTS_CURRENT_SERVER_HANDLE,
WTS_CURRENT_SESSION, WTSClientProtocolType, pBuf, pBytesReturned) then
    Exit;
  if (pBytesReturned > 0) {should be 2} then
  begin
    Result := PWord(pBuf)^;
    WTSFreeMemory(pBuf);
  end;
end;

function WTSSessionTypeToStr(ProtocolID: Word): String;
begin
  case ProtocolID of
    WTS_PROTOCOL_TYPE_CONSOLE: Result := 'WTS_PROTOCOL_TYPE_CONSOLE';
    WTS_SESSION_TYPE_ICA: Result := 'WTS_PROTOCOL_TYPE_ICA';
    WTS_SESSION_TYPE_RDP: Result := 'WTS_PROTOCOL_TYPE_RDP';
    else Result := 'WTS_SESSION_TYPE_UNKNOWN';
  end;//case
end;

Now only the hard part remains ...

Bart