VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "TSUserConfig"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Option Compare BinaryPrivate Declare Function WTSSetUserConfigString Lib "wtsapi32.dll" _
Alias "WTSSetUserConfigA" (ByVal pServerName As String, _
ByVal pUserName As String, ByVal WTSConfigClass As Long, _
ByVal pBuffer As String, ByVal pBytes As Long) As Long
Private Declare Function WTSSetUserConfigDWord Lib "wtsapi32.dll" _
Alias "WTSSetUserConfigA" (ByVal pServerName As String, _
ByVal pUserName As String, ByVal WTSConfigClass As Long, _
ByRef pBuffer As Long, ByVal pBytes As Long) As Long
Private Declare Function WTSQueryUserConfig Lib "wtsapi32.dll" _
Alias "WTSQueryUserConfigA" (ByVal pServerName As String, _
ByVal pUserName As String, ByVal WTSConfigClass As Long, _
ByRef pBuffer As Long, ByRef pBytesReturned As Long) As Long
Private Declare Sub WTSFreeMemory Lib "wtsapi32.dll" _
(ByVal pMemory As Any)
Private Declare Function NetGetDCName Lib "netapi32.dll" ( _
ServerName As Long, domainname As Byte, bufptr As Long) As Long
Private Declare Function NetApiBufferFree& Lib "netapi32" _
(ByVal Buffer As Long)
Private Declare Sub CopyMemory Lib "kernel32.dll" _
Alias "RtlMoveMemory" (ByRef aDestination As Long, _
ByVal lSource As Long, ByVal lBytesToCopy As Long)
Private Declare Sub CopyMemoryString Lib "kernel32" _
Alias "RtlMoveMemory" (ByVal hpvDest As String, _
ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Sub lstrcpyW Lib "kernel32" _
(dest As Any, ByVal src As Any)
' VB Constant declarations for WTS_CONFIG_CLASS
Const WTSUserConfigInitialProgram = &H0 ' string
Const WTSUserConfigWorkingDirectory = &H1 ' string
Const WTSUserConfigfInheritInitialProgram = &H2 ' DWORD
Const WTSUserConfigfAllowLogonTerminalServer = &H3 ' DWORD
' Timeout settings
Const WTSUserConfigTimeoutSettingsConnections = &H4 ' DWORD
Const WTSUserConfigTimeoutSettingsDisconnections = &H5 ' DWORD
Const WTSUserConfigTimeoutSettingsIdle = &H6 ' DWORD
' Client device settings
Const WTSUserConfigfDeviceClientDrives = &H7 ' DWORD
Const WTSUserConfigfDeviceClientPrinters = &H8 ' DWORD
Const WTSUserConfigfDeviceClientDefaultPrinter = &H9 ' DWORD
' Connection settings
Const WTSUserConfigBrokenTimeoutSettings = &HA ' DWORD
Const WTSUserConfigReconnectSettings = &HB ' DWORD
' Modem settings
Const WTSUserConfigModemCallbackSettings = &HC ' DWORD
Const WTSUserConfigModemCallbackPhoneNumber = &HD ' string
' Shadow settings
Const WTSUserConfigShadowingSettings = &HE ' DWORD
' User Profile settings
Const WTSUserConfigTerminalServerProfilePath = &HF ' string
' Terminal Server home directory
Const WTSUserConfigTerminalServerHomeDir = &H10 ' string
Const WTSUserConfigTerminalServerHomeDirDrive = &H11 ' string
Const WTSUserConfigfTerminalServerRemoteHomeDir = &H12 ' DWORD
Const NERR_Success = 0&
'*** ENumeration for VB editing
Public Enum TSParam
InitialProgram = &H0
WorkingDirectory = &H1
InheritInitialProgram = &H2
AllowLogonTerminalServer = &H3
TimeoutSettingsConnections = &H4
TimeoutSettingsDisconnections = &H5
TimeoutSettingsIdle = &H6
DeviceClientDrives = &H7
DeviceClientPrinters = &H8
DeviceClientDefaultPrinter = &H9
BrokenTimeoutSettings = &HA
ReconnectSettings = &HB
ModemCallbackSettings = &HC
ModemCallbackPhoneNumber = &HD
ShadowingSettings = &HE
TerminalServerProfilePath = &HF
TerminalServerHomeDir = &H10
TerminalServerHomeDirDrive = &H11
TerminalServerRemoteHomeDir = &H12
End Enum
'*** Private Variables
Private strpDomain As String
Private strpUserName As String
Private strpDCName As String
Private lngpTSError As Long
'*** Public Properties
Public Property Let UserName(NewUserName)
On Error Resume Next
strpUserName = CStr(NewUserName)
End Property
Public Property Get UserName()
On Error Resume Next
UserName = strpUserName
End Property
Public Property Let Domain(NewDomain)
On Error Resume Next
strpDomain = CStr(NewDomain)
End Property
Public Property Get Domain()
On Error Resume Next
Domain = strpDomain
End Property
Public Property Get TSError()
On Error Resume Next
TSError = lngpTSError
End Property
'*** Public Functions
Public Function QueryUserConfig(Param)
On Error Resume Next
Dim lngSize As Long
Dim lngBuffer As Long
Dim lngRetVal As Long
Dim strStringReturn As String
Dim lngDWordvalue As Long
strpDCName = fcnGetDC()
If fcnIsReturnValueString(Param) Then
' Query a string value (the user's initial program)
lngRetVal = WTSQueryUserConfig(strpDCName, strpUserName, _
Param, lngBuffer, lngSize)
If (lngRetVal = 0) Then
lngpTSError = Err.LastDllError
Exit Function
End If
' Copy the string value from the lngBuffer into a VB String variable
strStringReturn = Space(lngSize - 1)
CopyMemoryString strStringReturn, lngBuffer, lngSize
QueryUserConfig = strStringReturn
Else
' Query a DWORD value (the inherit initial program setting)
lngRetVal = WTSQueryUserConfig(strpDCName, strpUserName, _
Param, lngBuffer, lngSize)
If (lngRetVal = 0) Then
lngpTSError = Err.LastDllError
Exit Function
End If
' Copy the DWORD value from the lngBuffer into a Long variable
CopyMemory lngDWordvalue, lngBuffer, 4
QueryUserConfig = lngDWordvalue
End If
WTSFreeMemory (lngBuffer)
lngpTSError = 0&
End Function
Public Sub SetUserConfig(Param, Data)
On Error Resume Next
Dim lngRetVal As Long
Dim strStringValue As String
Dim lngDWordvalue As Long
If Param >= WTSUserConfigfTerminalServerRemoteHomeDir Or _
Param < 0& Then
lngpTSError = 87&
'*** illegal param value
Exit Sub
End If
strpDCName = fcnGetDC()
If fcnIsReturnValueString(Param) Then
strStringValue = CStr(Data)
lngRetVal = WTSSetUserConfigString(strpDCName, strpUserName, _
Param, strStringValue, Len(strStringValue))
If (lngRetVal = 0&) Then
lngpTSError = Err.LastDllError
Exit Sub
End If
Else
lngDWordvalue = CLng(Data)
lngRetVal = WTSSetUserConfigDWord(strpDCName, strpUserName, _
Param, lngDWordvalue, 4&)
If (lngRetVal = 0&) Then
lngpTSError = Err.LastDllError
Exit Sub
End If
End If
lngpTSError = 0&
End Sub
'*** Private Functions
Private Function fcnGetDC() As String
On Error Resume Next
Dim Status As Long
Dim lngBuffer As Long
Dim DNArray() As Byte
Dim DCNArray(100) As Byte
DNArray = strpDomain & vbNullChar
Status = NetGetDCName(0&, DNArray(0), lngBuffer)
If Status <> NERR_Success Then
lngpTSError = Err.LastDllError
Exit Function
End If
lstrcpyW DCNArray(0), lngBuffer
Status = NetApiBufferFree(lngBuffer)
fcnGetDC = DCNArray()
End Function
Private Function fcnIsReturnValueString(ByVal lngParam As TSParam) As Boolean
On Error Resume Next
fcnIsReturnValueString = False
If lngParam = WTSUserConfigInitialProgram _
Or lngParam = WTSUserConfigWorkingDirectory _
Or lngParam = WTSUserConfigModemCallbackPhoneNumber _
Or lngParam = WTSUserConfigTerminalServerProfilePath _
Or lngParam = WTSUserConfigTerminalServerHomeDir _
Or lngParam = WTSUserConfigTerminalServerHomeDirDrive _
Then
fcnIsReturnValueString = True
End If
End Function
'*** http://msdn.microsoft.com/library/default.asp?url=/library/en-us/termserv/tsref_9z76.asp
'WTSUserConfigInitialProgram
'A null-terminated string containing the path of the initial program that Terminal Services
'runs when the user logs on.
'If the WTSUserConfigfInheritInitialProgram value is 1, the initial program can be any
'program specified by the client.
'WTSUserConfigWorkingDirectory
'A null-terminated string containing the path of the working directory for the initial
'program.
'WTSUserConfigfInheritInitialProgram
'A value that indicates whether the client can specify the initial program. Value Meaning
'0 The client cannot specify the initial program. The WTSUserConfigInitialProgram string
'indicates the initial program. If you specify a user's initial program, that's the only
'program they can run; terminal server logs off the user when the user exits that program.
'1 The client can specify the initial program.
'WTSUserConfigfAllowLogonTerminalServer
'A value that indicates whether the user account is permitted to log on to a terminal server.
'Value Meaning
'0 The user cannot logon.
'1 The user can logon.
'WTSUserConfigTimeoutSettingsConnections
'A DWORD value that specifies the maximum connection duration, in milliseconds. One minute
'before the connection timeout interval expires, the user is notified of the pending
'disconnection. The user's session is disconnected or terminated depending on the
'WTSUserConfigBrokenTimeoutSettings value. Every time the user logs on, the timer is reset.
'A value of zero indicates the connection timer is disabled.
'WTSUserConfigTimeoutSettingsDisconnections
'A DWORD value that specifies the maximum duration, in milliseconds, that a terminal
'server retains a disconnected session before the logon is terminated. A value of zero
'indicates the disconnection timer is disabled.
'WTSUserConfigTimeoutSettingsIdle
'A DWORD value that specifies the maximum idle time, in milliseconds. If there is no
'keyboard or mouse activity for the specified interval, the user's session is disconnected
'or terminated depending on the WTSUserConfigBrokenTimeoutSettings value. A value of zero
'indicates the idle timer is disabled.
'WTSUserConfigfDeviceClientDrives
'Citrix ICA clients: A value that indicates whether the terminal server automatically
'reestablishes client drive mappings at logon. Value Meaning
'0 The server does not automatically connect to previously mapped client drives.
'1 The server automatically connects to previously mapped client drives at logon.
'WTSUserConfigfDeviceClientPrinters
'RDP 5.0 clients and Citrix ICA clients: A value that indicates whether the terminal server
'automatically reestablishes client printer mappings at logon. Value Meaning
'0 The server does not automatically connect to previously mapped client printers.
'1 The server automatically connects to previously mapped client printers at logon.
'WTSUserConfigfDeviceClientDefaultPrinter
'RDP 5.0 clients and Citrix ICA clients: A value that indicates whether the client printer
'is the default printer. Value Meaning
'0 The client printer is not the default printer.
'1 The client printer is the default printer.
'WTSUserConfigBrokenTimeoutSettings
'A value that indicates what happens when the connection or idle timers expire or when a
'connection is lost due to a connection error. Value Meaning
'0 The session is disconnected.
'1 The session is terminated.
'WTSUserConfigReconnectSettings
'A value that indicates how a disconnected session for this user can be reconnected.
'Value Meaning
'0 The user can log on to any client computer to reconnect to a disconnected session.
'Note that sessions started at clients other than the system console cannot be connected
'to the system console, and sessions started at the system console cannot be disconnected.
'1 The user can reconnect to a disconnected session by logging on to the client computer
'used to establish the disconnected session. If the user logs on from a different client
'computer, the user gets a new logon session.
'WTSUserConfigModemCallbackSettings
'Citrix ICA clients: A value that indicates the configuration for dialup connections in which
'the terminal server hangs up and then calls back the client to establish the connection.
'Value Meaning
'0 Callback connections are disabled.
'1 The server prompts the user to enter a phone number and calls the user back at that phone
'number. You can use the WTSUserConfigModemCallbackPhoneNumber value to specify a default
'phone number.
'2 The server automatically calls the user back at the phone number specified by the
'WTSUserConfigModemCallbackPhoneNumber value.
'WTSUserConfigModemCallbackPhoneNumber
'Citrix ICA clients: A null-terminated string containing the phone number to use for callback
'connections.
'WTSUserConfigShadowingSettings
'RDP 5.0 clients and Citrix ICA clients: A value that indicates whether the user session can
'be shadowed. Shadowing allows a user to remotely monitor the on-screen operations of another user.
'Value Meaning
'0 Disable
'1 Enable input, notify
'2 Enable input, no notify
'3 Enable no input, notify
'4 Enable no input, no notify
'WTSUserConfigTerminalServerProfilePath
'A null-terminated string containing the path of the user's profile for terminal server logon.
'The directory the path identifies must be created manually, and must exist prior to the logon.
'WTSSetUserConfig will not create the directory if it does not already exist.
'WTSUserConfigTerminalServerHomeDir
'A null-terminated string containing the path of the user's home directory for terminal server
'logon. This string can specify a local path or a UNC path (\\machine\share\path). See
'WTSUserConfigfTerminalServerRemoteHomeDir.
WTSUserConfigTerminalServerHomeDirDrive
'A null-terminated string containing a drive specification (a drive letter followed by a colon)
'to which the UNC path specified in the WTSUserConfigTerminalServerHomeDir string is mapped.
'See WTSUserConfigfTerminalServerRemoteHomeDir.
WTSUserConfigfTerminalServerRemoteHomeDir
'A value that indicates whether the user's home directory for terminal server logon is a local
'path or a mapped drive letter. Note that this value cannot be used with WTSSetUserConfig.
'Value Meaning
'0 The WTSUserConfigTerminalServerHomeDir string contains the local path of the user's terminal
'server logon home directory.
'1 The WTSUserConfigTerminalServerHomeDir string contains the UNC path of the user's terminal
'server logon home directory, and the WTSUserConfigTerminalServerHomeDirDrive string contains
'a drive letter to which the UNC path is mapped.
