Einzelnen Beitrag anzeigen

HolgerX

Registriert seit: 10. Apr 2006
Ort: Leverkusen
946 Beiträge
 
Delphi 6 Professional
 
#6

AW: Terminalserver-Betrieb unter 64bit erkennen

  Alt 21. Feb 2015, 14:57
Hallo..

Envoimentvariablen sollten besser nicht genutzt werden.

Wie bereits gesagt, kann da alles liegen, gerade in TherminalServer-Umgebungen wird dort oft durch loginScripte anderes eingetragen.

Hier eine Routine, welche funktioniert, mit Delphi6 - XE6.

Code:
uses
  Windows, wtsapi32;


function ProcessIdToSessionId(dwProcessId: DWORD;var pSessionId: DWORD): BOOL; stdcall; external kernel32 name 'ProcessIdToSessionId';


function GetPCSystemName : WideString;
var
  lpBuf : PWideChar;
  nSi : DWORD;
begin
  Result := '';
  nSi := (1024 + 2) * SizeOf(WideChar);
  GetMem(lpBuf, nSi);
  try
    if GetComputerNameW(lpBuf, nSi) then Result := lpBuf;
  finally
    FreeMem(lpBuf);
  end;
end;

function GetPCClientName : WideString;
var
  nProcessID, nSessionID : DWORD;
  nByteCount : DWORD;
  acNameBuff : Pointer;
  tmpName   : WideString;
begin
  // Lokaler HostName
  Result := GetPCSystemName;
  nProcessID := GetCurrentProcessId;
  nSessionID := 0;
  //PROCESS_QUERY_INFORMATION wird benötigt für ProcessIdToSessionID         "SeDebugPrivilege"
  // SessionID von aktueller ProcessID
  if ProcessIdToSessionID( nProcessID, nSessionID) then begin
    // Wenn in einer Session..
    if nSessionID > 0 then begin
      // Session ClientName
      if WTSQuerySessionInformationW(WTS_CURRENT_SERVER_HANDLE, nSessionId, WTSClientName, acNameBuff, nByteCount) then begin
        try
          tmpName := PWideChar(acNameBuff);
          // Da bei Vista kein Name vorhanden ist, auf Leerstring prüfen!
          if tmpName <> '' then
            result := tmpName;
        finally
          WTSFreeMemory(acNameBuff);
        end;
      end;
    end;
  end;
end;

Mit ProcessIdToSessionId Kannst Du ermitteln, ob deine App in einer Therminal-Session läuft und dann kannste mit WTSQuerySessionInformationW den ClientSession-Name auslesen.

Dies funktioniert (getestet) ab WinXP bis zu Win8.1 (64Bit).
  Mit Zitat antworten Zitat