ZjiÜt∞nφ ID sezenφ terminßlovΘho serveru

Postup:
Option Explicit

Private Declare Function WTSEnumerateProcesses Lib _
   "wtsapi32.dll" Alias "WTSEnumerateProcessesA" _
   (ByVal hServer As Long, ByVal Reserved As Long, _
   ByVal Version As Long, ByRef ppProcessInfo As Long, _
   ByRef pCount As Long) As Long
Private Declare Sub WTSFreeMemory Lib "wtsapi32.dll" _
   (ByVal pMemory As Long)
Private Declare Sub CopyMemory Lib "Kernel32" Alias _
   "RtlMoveMemory" (Destination As Any, Source As Any, _
   ByVal Length As Long)
Private Declare Function GetCurrentProcessId Lib "Kernel32" () As Long

Private Type WTS_PROCESS_INFO
   SessionID As Long
   ProcessId As Long
   pProcessName As Long
   pUserSid As Long
End Type


Function TerminalServerSessionId() As String

   Dim lRetVal As Long, lCount As Long
   Dim lThisProcess As Long, lThisProcessId As Long
   Dim lpBuffer As Long, lp As Long
   Dim udtProcessInfo As WTS_PROCESS_INFO

   Const WTS_CURRENT_SERVER_HANDLE = 0&

   On Error GoTo ErrNotTerminalServer
   TerminalServerSessionId = "0"
   lThisProcessId = GetCurrentProcessId
   lRetVal = WTSEnumerateProcesses(WTS_CURRENT_SERVER_HANDLE, _
      0&, 1, lpBuffer, lCount)
   If lRetVal Then
      lp = lpBuffer
      For lThisProcess = 1 To lCount
         CopyMemory udtProcessInfo, ByVal lp, LenB(udtProcessInfo)
         If lThisProcessId = udtProcessInfo.ProcessId Then
            TerminalServerSessionId = CStr(udtProcessInfo.SessionID)
            Exit For
         End If
         lp = lp + LenB(udtProcessInfo)
      Next
      WTSFreeMemory lpBuffer
   End If

Exit Function

ErrNotTerminalServer:
  On Error GoTo 0

End Function

Zp∞t