Monolithic TS API Wrapper

I started working on wrapping some of the Terminal Services API calls a few months ago, after having initially played with VB a bit as a means of producing ActiveX DLLs for use in scripting.

The code below is a current snapshot of status on this project.  There are a couple of significant credits due for support in this, but I'm not putting those up until I feel more comfortable with the status of the project - no sense in embarrassing my mentors at this point...<g>

Goal

The target of this project is a monolithic module with  every exposed constant, function, enumeration, and type within wtsapi32  correctly wrapped and then safely exposed for use within VB6 projects.

This will not cover everything which can be done via Terminal Services; I have done some separate work with virtual channels, and although the server side is technically part of this, any possible client side operation will be completely separate.

Sources

The primary source for information so far has been the Microsoft Platform SDK.  Constants have been pulled from the following header files:

There are of course the usual connections to other libraries such as kernel32.

Platforms

As a primarily server-side project, this has really been designed with one platform in mind: Windows 2000 Terminal Services in Application Mode.

Functionality extends beyond that.  Code tested so far generally works fine on NT4 TSE and .NET RC1; it also works on Windows XP Professional (and Home to a certain extent) due to the presence of wtsapi32 on the latter platforms.

Code

Here's the 2002.09.13 codebase in the raw.



Option Explicit

' Module contains constants defined within the primary
' Terminal Services header files:
' wtsapi32.h
' cchannel.h
' pchannel.h
' Source: Nov 2001 Platform SDK, release version include files


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Constants from wtsapi32.h
' Windows Terminal Server Private APIs
' 2001-05-29 version, 27097 bytes
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Kept in roughly the order used within wtsapi32.h

' Flags for Console Notification
Private Const NOTIFY_FOR_ALL_SESSIONS = 1&
Private Const NOTIFY_FOR_THIS_SESSION = 0&

' These Constants specify the current server
Private Const WTS_CURRENT_SERVER = 0&
Private Const WTS_CURRENT_SERVER_HANDLE = 0&
' following was shown as a NULL in the API
Private Const WTS_CURRENT_SERVER_NAME = vbNullString

' Specifies the current session (SessionId)
Private Const WTS_CURRENT_SESSION As Long = -1

' Possible pResponse values from WTSSendMessage()
Private Const IDTIMEOUT = 32000&
Private Const IDASYNC = 32001&


' Shutdown flags

' log off all users except current one
' MUST reboot before winstations can be recreated
Private Const WTS_WSD_LOGOFF = &H1
'
' shutdown system
Private Const WTS_WSD_SHUTDOWN = &H2
'
' shutdown and reboot
Private Const WTS_WSD_REBOOT = &H4
'
' shutdown - and power off if hardware supports it
Private Const WTS_WSD_POWEROFF = &H8
'
' reboot without logging off users or shutting down
Private Const WTS_WSD_FASTREBOOT = &H10
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


' WTS_EVENT - Event flags for WTSWaitSystemEvent
Public Const WTS_EVENT_NONE = &H0 ' return no event
Public Const WTS_EVENT_CREATE = &H1 ' new WinSta created
Public Const WTS_EVENT_DELETE = &H2 ' existing WinSta deleted
Public Const WTS_EVENT_RENAME = &H4 ' existing WinSta renamed
Public Const WTS_EVENT_CONNECT = &H8 ' WinSta connect to client
Public Const WTS_EVENT_DISCONNECT = &H10 ' WinSta logged on w/o client
Public Const WTS_EVENT_LOGON = &H20  ' user logged on to WinSta
Public Const WTS_EVENT_LOGOFF = &H40      ' user logged off from WinSta
Public Const WTS_EVENT_STATECHANGE = &H80 ' WinSta state change
Public Const WTS_EVENT_LICENSE = &H100 ' license state change
Public Const WTS_EVENT_ALL = &H7FFFFFFF ' wait for all event types
Public Const WTS_EVENT_FLUSH = &H80000000 ' unblock all waiters

Private Const WTS_PROTOCOL_TYPE_CONSOLE = 0& ' Console
Private Const WTS_PROTOCOL_TYPE_ICA = 1& ' ICA Protocol
Private Const WTS_PROTOCOL_TYPE_RDP = 2& ' RDP Protocol
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'WTS_EVENT_NONE
' Constants from cchannel.h included in Platform SDK
' Virtual Channel Client API
' 2001-04-11 version, 21036 bytes
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Levels of Virtual Channel Support
Private Const VIRTUAL_CHANNEL_VERSION_WIN2000 = 1&

' Events passed to VirtualChannelInitEvent

' Client initialized (no data)
Private Const CHANNEL_EVENT_INITIALIZED = 0&
'
' Connection established (data = name of Server)
Private Const CHANNEL_EVENT_CONNECTED = 1&
'
' Connection established with old Server, so no channel support
Private Const CHANNEL_EVENT_V1_CONNECTED = 2&
'
' Connection ended (no data)
Private Const CHANNEL_EVENT_DISCONNECTED = 3&
'
' Client terminated (no data)
Private Const CHANNEL_EVENT_TERMINATED = 4&
'
' NOTE - 5 through 9 not listed in cchannel.h
' Data received from Server
' (data = incoming data)
Private Const CHANNEL_EVENT_DATA_RECEIVED = 10&
'
' VirtualChannelWrite completed
' (pData - pUserData passed on VirtualChannelWrite)
Private Const CHANNEL_EVENT_WRITE_COMPLETE = 11&
'
' VirtualChannelWrite cancelled
' (pData - pUserData passed on VirtualChannelWrite)
Private Const CHANNEL_EVENT_WRITE_CANCELLED = 12&
'
' Return codes from VirtualChannelXxx functions
Private Const CHANNEL_RC_OK = 0&
Private Const CHANNEL_RC_ALREADY_INITIALIZED = 1&
Private Const CHANNEL_RC_NOT_INITIALIZED = 2&
Private Const CHANNEL_RC_ALREADY_CONNECTED = 3&
Private Const CHANNEL_RC_NOT_CONNECTED = 4&
Private Const CHANNEL_RC_TOO_MANY_CHANNELS = 5&
Private Const CHANNEL_RC_BAD_CHANNEL = 6&
Private Const CHANNEL_RC_BAD_CHANNEL_HANDLE = 7&
Private Const CHANNEL_RC_NO_BUFFER = 8&
Private Const CHANNEL_RC_BAD_INIT_HANDLE = 9&
Private Const CHANNEL_RC_NOT_OPEN = 10&
Private Const CHANNEL_RC_BAD_PROC = 11&
Private Const CHANNEL_RC_NO_MEMORY = 12&
Private Const CHANNEL_RC_UNKNOWN_CHANNEL_NAME = 13&
Private Const CHANNEL_RC_ALREADY_OPEN = 14&
Private Const CHANNEL_RC_NOT_IN_VIRTUALCHANNELENTRY = 15&
Private Const CHANNEL_RC_NULL_DATA = 16&
Private Const CHANNEL_RC_ZERO_LENGTH = 17&
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Constants from Pchannel.h included in Platform SDK
' Virtual Channel protocol header
' VC stuff common to Client & Server
' 2001-04-11 version, 8603 bytes
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const CHANNEL_CHUNK_LENGTH = 1600&
Private Const CHANNEL_FLAG_FIRST = 1&
Private Const CHANNEL_FLAG_LAST = 2&
Private Const CHANNEL_FLAG_MIDDLE = 0&
Private Const CHANNEL_FLAG_FAIL = 256&
Private Const CHANNEL_FLAG_SHOW_PROTOCOL = 16&
Private Const CHANNEL_FLAG_SUSPEND = 32&
Private Const CHANNEL_FLAG_RESUME = 64&
Private Const CHANNEL_OPTION_INITIALIZED = &H80000000
Private Const CHANNEL_OPTION_ENCRYPT_RDP = 1073741824
Private Const CHANNEL_OPTION_ENCRYPT_SC = 536870912
Private Const CHANNEL_OPTION_ENCRYPT_CS = 268435456
Private Const CHANNEL_OPTION_PRI_HIGH = 134217728
Private Const CHANNEL_OPTION_PRI_MED = 67108864
Private Const CHANNEL_OPTION_PRI_LOW = 33554432
Private Const CHANNEL_OPTION_COMPRESS_RDP = 8388608
Private Const CHANNEL_OPTION_COMPRESS = 4194304
Private Const CHANNEL_OPTION_SHOW_PROTOCOL = 2097152
Private Const CHANNEL_MAX_COUNT = 30&
Private Const CHANNEL_NAME_LEN = 7&



Private Const SE_REMOTE_SHUTDOWN_NAME = "SeRemoteShutdownPrivilege"
Private Type WTS_CLIENT_NAME
  TNAME As String * 10
End Type


Private Type WTS_CLIENT_INFO
  CINFO As String * 20
End Type


Private Type WTS_CLIENT_DISPLAY
  HorizontalResolution As Long ' horizontal dimensions, in pixels
  VerticalResolution As Long ' vertical dimensions, in pixels
  ColorDepth As Long ' see Color Constants above (AKA)
End Type


Private Type WTS_CLIENT_ADDRESS
  ADDRESSFAMILY As Long
  ' Address family. This member can be AF_INET, AF_IPX, AF_NETBIOS, or AF_UNSPEC
  ADDRESS(20) As Byte
  ' Client network address
End Type


Private Type WTS_PROCESS_INFO
  SessionId As Long
  ' session id
  ProcessId As Long
  ' process id
  pProcessName As String
  ' name of process
  pUserSid As Variant
  ' user's SID
End Type


Private Type WTS_SESSION_INFO
  SessionId As Long
  pWinStationName As Long
  state As WTS_CONNECTSTATE_CLASS
End Type


Private Type WTS_SESSION_QUERY
  SessionId As Long
  pWinStationName As Long
  senum As WTS_INFO_CLASS
  ' Need to add Info for this class
End Type

Private Type LUID
  UsedPart As Long
  IgnoredForNowHigh32BitPart As Long
End Type
Private Type TOKEN_PRIVILEGES
  PrivilegeCount As Long
  TheLuid As LUID
  Attributes As Long
End Type
Private Enum WTS_CONFIG_CLASS
  WTSUserConfigInitialProgram
  WTSUserConfigWorkingDirectory
  WTSUserConfigfInheritInitialProgram
  WTSUserConfigfAllowLogonTerminalServer
  WTSUserConfigTimeoutSettingsConnections
  WTSUserConfigTimeoutSettingsDisconnections
  WTSUserConfigTimeoutSettingsIdle
  WTSUserConfigfDeviceClientDrives
  WTSUserConfigfDeviceClientPrinters
  WTSUserConfigfDeviceClientDefaultPrinter
  WTSUserConfigBrokenTimeoutSettings
  WTSUserConfigReconnectSettings
  WTSUserConfigModemCallbackSettings
  WTSUserConfigModemCallbackPhoneNumber
  WTSUserConfigShadowingSettings
  WTSUserConfigTerminalServerProfilePath
  WTSUserConfigTerminalServerHomeDir
  WTSUserConfigTerminalServerHomeDirDrive
  WTSUserConfigfTerminalServerRemoteHomeDir
End Enum

Private Enum WTS_CONNECTSTATE_CLASS
  WTSActive
  WTSConnected
  WTSConnectQuery
  WTSShadow
  WTSDisconnected
  WTSIdle
  WTSListen
  WTSReset
  WTSDown
  WTSInit
End Enum

Private Enum WTS_INFO_CLASS
  WTSInitialProgram
  WTSApplicationName
  WTSWorkingDirectory
  WTSOEMId
  WTSSessionId
  WTSUserName
  WTSWinStationName
  WTSDomainName
  WTSConnectState
  WTSClientBuildNumber
  WTSClientName
  WTSClientDirectory
  WTSClientProductId
  WTSClientHardwareId
  WTSClientAddress
  WTSClientDisplay
  WTSClientProtocolType
End Enum

Private Enum WTS_VIRTUAL_CLASS
  WTSVirtualClientData
  WTSVirtualFileHandle
End Enum

' ===================================================================
' WTSQueryUserConfig
' returns config info about specified user on specified server.
' ===================================================================
Private Declare Function WTSQueryUserConfig Lib "wtsapi32" _
    (ByVal pServerName As String, _
    ByVal pUserName As String, ByVal WTSConfigClass As WTS_CONFIG_CLASS, _
    ByRef ppBuffer As Long, ByRef pBytesReturned As Long) As Long
Private Declare Sub WTSFreeMemory Lib "wtsapi32" (ByVal pMemory As Long)

Private Declare Function WTSGetActiveConsoleSessionId Lib "wtsapi32.dll" () As Long
Private Declare Function WTSOpenServer Lib "wtsapi32.dll" Alias "WTSOpenServerA" ( _
    ByVal pServerName As String) As Long
Private Declare Function WTSDisconnectSession Lib "wtsapi32" (ByVal hServer As Long, _
    ByVal SessionId As Long, ByVal bWait As Long) As Long

Private Declare Function WTSLogoffSession Lib "wtsapi32" (ByVal hServer As Long, _
    ByVal SessionId As Long, ByVal bWait As Long) As Long

Private Declare Function WTSCloseServer Lib "wtsapi32.dll" (ByVal hServer As Long) As Long

Private Declare Function WTSTerminateProcess Lib "wtsapi32.dll" (ByVal hServer As Long, _
    ByVal ProcessId As Long, ByVal ExitCode As Long) As Long
Private Declare Function WTSShutdownSystem Lib "wtsapi32" ( _
    ByVal hServer As Long, ByVal ShutdownFlags As Long) As Long

Private Declare Function ProcessIdToSessionId Lib "kernel32.dll" (ByVal dwProcessId As Long, ByRef pSessionId As Long) As Long


Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" ( _
    ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
    NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _
    PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function OpenProcess Lib "kernel32" ( _
 ByVal dwDesiredAccess As Long, _
 ByVal bInheritHandle As Long, _
 ByVal dwProcessId As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long


Private Declare Function lstrlenA Lib "kernel32" ( _
    ByVal lpString As String) As Long

' Reserved = 0&, Version = 1& always
Private Declare Function WTSEnumerateProcesses Lib "wtsapi32" ( _
ByVal hServer As Long, ByVal Reserved As Long, _
 ByVal Version As Long, ByRef ppProcessInfo As Long, _
  ByRef pCount As Long) As Long

Private Sub AdjustToken(PrivilegeType As String)
  Dim hdlTokenHandle As Long
  Dim tmpLuid As LUID
  Dim oTKP As TOKEN_PRIVILEGES
  Dim tkpNewButIgnored As TOKEN_PRIVILEGES
  Dim lBuffer As Long
  OpenProcessToken GetCurrentProcess(), _
   (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
  LookupPrivilegeValue "", PrivilegeType, tmpLuid
  oTKP.PrivilegeCount = 1    ' One privilege to set
  oTKP.TheLuid = tmpLuid
  oTKP.Attributes = SE_PRIVILEGE_ENABLED
  ' Enable the privilege in the access token of this process.
  AdjustTokenPrivileges hdlTokenHandle, False, oTKP, _
   Len(tkpNewButIgnored), tkpNewButIgnored, lBuffer
End Sub

' ===================================================================
' "HANDLE" Functions - open a handle to server, close it
' ===================================================================

Private Function CloseServerHandle(ByVal hServer As Long) As Long
  If hServer <> 0& Then CloseServerHandle = WTSCloseServer(hServer)
End Function

Private Function OpenServerHandle(ByVal Server As String) As Long
  If Server = "" Then
    OpenServerHandle = WTS_CURRENT_SERVER_HANDLE
  Else
    OpenServerHandle = WTSOpenServer(Server)
  End If
End Function
' ===================================================================
' Session Functions - Logoff or Disconnect
' ===================================================================

Public Function LogoffSession(ByVal SessionId As Long, _
 Optional Server As String = "", Optional bWait As Boolean = False)
  Dim hServer, lTmp As Long
  hServer = OpenServerHandle(Server)
  LogoffSession = WTSLogoffSession(hServer, SessionId, CLng(bWait))
  lTmp = CloseServerHandle(hServer)
End Function

Public Function DisconnectSession(ByVal SessionId As Long, _
 Optional Server As String = "", Optional bWait As Boolean = False)
  Dim hServer, lTmp As Long
  hServer = OpenServerHandle(Server)
  DisconnectSession = WTSDisconnectSession(hServer, SessionId, CLng(bWait))
  lTmp = CloseServerHandle(hServer)
End Function

Public Function TerminateProcess(ProcessId As Long, _
 ExitCode As Long, Optional Server As String = "")
  ' Will NOT work on
  Dim hServer, lTmp As Long
  hServer = OpenServerHandle(Server)
  lTmp = WTSTerminateProcess(hServer, ProcessId, ExitCode)
  TerminateProcess = lTmp
  lTmp = CloseServerHandle(hServer)
End Function

Public Function GetActiveConsoleSessionId() As Long
  ' Appears to NOT work for XP app host to Win2K TS
  ' but that is not a specifically supported configuration
  GetActiveConsoleSessionId = WTSGetActiveConsoleSessionId
End Function

Public Function PidToSessionId(pid As Long) As Long
  Dim lRtn, SessionId, lErr As Long
  lRtn = ProcessIdToSessionId(pid, SessionId)
  lErr = Err.LastDllError
  PidToSessionId = SessionId
End Function

Public Function TSShutdown(ShutdownType As Long, _
 Optional Server As String = "") As Long
  Dim hServer, lTmp As Long
  hServer = OpenServerHandle(Server)
  AdjustToken (SE_REMOTE_SHUTDOWN_NAME)
  lTmp = WTSShutdownSystem(hServer, ShutdownType)
  lTmp = CloseServerHandle(hServer)
  TSShutdown = lTmp
End Function