远程用户

Public Class Form1

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

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _ <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Private Structure WTS_SESSION_INFO Private Structure WTS_SESSION_INFO
Dim SessionID As Int32 'DWORD integer Dim SessionID As Int32 'DWORD integer
Dim pWinStationName As String ' integer LPTSTR - Pointer to a null-terminated string containing the name of the WinStation for this session Dim pWinStationName As String ' integer LPTSTR - Pointer to a null-terminated string containing the name of the WinStation for this session
Dim State As WTS_CONNECTSTATE_CLASS Dim State As WTS_CONNECTSTATE_CLASS
End Structure End Structure

Friend Structure strSessionsInfo Friend Structure strSessionsInfo
Dim SessionID As Integer Dim SessionID As Integer
Dim StationName As String Dim StationName As String
Dim ConnectionState As String Dim ConnectionState As String
End Structure End Structure

Private Enum WTS_INFO_CLASS Private Enum WTS_INFO_CLASS
WTSInitialProgram WTSInitialProgram
WTSApplicationName WTSApplicationName
WTSWorkingDirectory WTSWorkingDirectory
WTSOEMId WTSOEMId
WTSSessionId WTSSessionId
WTSUserName WTSUserName
WTSWinStationName WTSWinStationName
WTSDomainName WTSDomainName
WTSConnectState WTSConnectState
WTSClientBuildNumber WTSClientBuildNumber
WTSClientName WTSClientName
WTSClientDirectory WTSClientDirectory
WTSClientProductId WTSClientProductId
WTSClientHardwareId WTSClientHardwareId
WTSClientAddress WTSClientAddress
WTSClientDisplay WTSClientDisplay
WTSClientProtocolType WTSClientProtocolType
WTSIdleTime WTSIdleTime
WTSLogonTime WTSLogonTime
WTSIncomingBytes WTSIncomingBytes
WTSOutgoingBytes WTSOutgoingBytes
WTSIncomingFrames WTSIncomingFrames
WTSOutgoingFrames WTSOutgoingFrames
End Enum End Enum
'Structure for TS Client IP Address 'Structure for TS Client IP Address
<StructLayout(LayoutKind.Sequential)> _ <StructLayout(LayoutKind.Sequential)> _
Private Structure _WTS_CLIENT_ADDRESS Private Structure _WTS_CLIENT_ADDRESS
Public AddressFamily As Integer Public AddressFamily As Integer
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=20)> _ <MarshalAs(UnmanagedType.ByValArray, SizeConst:=20)> _
Public Address As Byte() Public Address As Byte()
End Structure End Structure
'Structure for TS Client Information 'Structure for TS Client Information
Friend Structure WTS_CLIENT_INFO Friend Structure WTS_CLIENT_INFO
Public WTSStatus As Boolean Public WTSStatus As Boolean
Public WTSUserName As String Public WTSUserName As String
Public WTSStationName As String Public WTSStationName As String
Public WTSDomainName As String Public WTSDomainName As String
Public WTSClientName As String Public WTSClientName As String
Public AddressFamily As Integer Public AddressFamily As Integer
Public Address As Byte() Public Address As Byte()
End Structure End Structure

'Function for TS Session Information excluding Client IP address 'Function for TS Session Information excluding Client IP address
Private Declare Function WTSQuerySessionInformation Lib "WtsApi32.dll" Alias "WTSQuerySessionInformationW" (ByVal hServer As Int32, _ Private Declare Function WTSQuerySessionInformation Lib "WtsApi32.dll" Alias "WTSQuerySessionInformationW" (ByVal hServer As Int32, _
ByVal SessionId As Int32, ByVal WTSInfoClass As Int32, <MarshalAs(UnmanagedType.LPWStr)> ByRef ppBuffer As String, ByRef pCount As Int32) As Boolean ByVal SessionId As Int32, ByVal WTSInfoClass As Int32, <MarshalAs(UnmanagedType.LPWStr)> ByRef ppBuffer As String, ByRef pCount As Int32) As Boolean

'Function for TS Client IP Address 'Function for TS Client IP Address
Private Declare Function WTSQuerySessionInformation2 Lib "WtsApi32.dll" Alias "WTSQuerySessionInformationW" (ByVal hServer As Int32, _ Private Declare Function WTSQuerySessionInformation2 Lib "WtsApi32.dll" Alias "WTSQuerySessionInformationW" (ByVal hServer As Int32, _
ByVal SessionId As Int32, ByVal WTSInfoClass As Int32, ByRef ppBuffer As IntPtr, ByRef pCount As Int32) As Boolean ByVal SessionId As Int32, ByVal WTSInfoClass As Int32, ByRef ppBuffer As IntPtr, ByRef pCount As Int32) As Boolean

Private Declare Function GetCurrentProcessId Lib "Kernel32.dll" Alias "GetCurrentProcessId" () As Int32 Private Declare Function GetCurrentProcessId Lib "Kernel32.dll" Alias "GetCurrentProcessId" () As Int32
Private Declare Function ProcessIdToSessionId Lib "Kernel32.dll" Alias "ProcessIdToSessionId" (ByVal processID As Int32, ByRef sessionID As Int32) As Boolean Private Declare Function ProcessIdToSessionId Lib "Kernel32.dll" Alias "ProcessIdToSessionId" (ByVal processID As Int32, ByRef sessionID As Int32) As Boolean
Private Declare Function WTSGetActiveConsoleSessionId Lib "Kernel32.dll" Alias "WTSGetActiveConsoleSessionId" () As Int32 Private Declare Function WTSGetActiveConsoleSessionId Lib "Kernel32.dll" Alias "WTSGetActiveConsoleSessionId" () As Int32


<DllImport("wtsapi32.dll", _ <DllImport("wtsapi32.dll", _
bestfitmapping:=True, _ bestfitmapping:=True, _
CallingConvention:=CallingConvention.StdCall, _ CallingConvention:=CallingConvention.StdCall, _
CharSet:=CharSet.Auto, _ CharSet:=CharSet.Auto, _
EntryPoint:="WTSEnumerateSessions", _ EntryPoint:="WTSEnumerateSessions", _
setlasterror:=True, _ setlasterror:=True, _
ThrowOnUnmappableChar:=True)> _ ThrowOnUnmappableChar:=True)> _
Private Shared Function WTSEnumerateSessions( _ Private Shared Function WTSEnumerateSessions( _
ByVal hServer As IntPtr, _ ByVal hServer As IntPtr, _
<MarshalAs(UnmanagedType.U4)> _ <MarshalAs(UnmanagedType.U4)> _
ByVal Reserved As Int32, _ ByVal Reserved As Int32, _
<MarshalAs(UnmanagedType.U4)> _ <MarshalAs(UnmanagedType.U4)> _
ByVal Vesrion As Int32, _ ByVal Vesrion As Int32, _
ByRef ppSessionInfo As IntPtr, _ ByRef ppSessionInfo As IntPtr, _
<MarshalAs(UnmanagedType.U4)> _ <MarshalAs(UnmanagedType.U4)> _
ByRef pCount As Int32) As Int32 ByRef pCount As Int32) As Int32
End Function End Function

<DllImport("wtsapi32.dll")> _ <DllImport("wtsapi32.dll")> _
Private Shared Sub WTSFreeMemory(ByVal pMemory As IntPtr) Private Shared Sub WTSFreeMemory(ByVal pMemory As IntPtr)
End Sub End Sub

<DllImport("wtsapi32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _ <DllImport("wtsapi32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Private Shared Function WTSOpenServer(ByVal pServerName As String) As IntPtr Private Shared Function WTSOpenServer(ByVal pServerName As String) As IntPtr
End Function End Function

<DllImport("wtsapi32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _ <DllImport("wtsapi32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Private Shared Sub WTSCloseServer(ByVal hServer As IntPtr) Private Shared Sub WTSCloseServer(ByVal hServer As IntPtr)
End Sub End Sub

Friend Function GetSessions(ByVal ServerName As String, ByRef ClientInfo As WTS_CLIENT_INFO) As Boolean Friend Function GetSessions(ByVal ServerName As String, ByRef ClientInfo As WTS_CLIENT_INFO) As Boolean
Dim ptrOpenedServer As IntPtr Dim ptrOpenedServer As IntPtr
Try Try
ptrOpenedServer = WTSOpenServer(ServerName) ptrOpenedServer = WTSOpenServer(ServerName)
If ptrOpenedServer = vbNull Then If ptrOpenedServer = vbNull Then
MessageBox.Show("Terminal Services not running on : " & ServerName) MessageBox.Show("Terminal Services not running on : " & ServerName)
GetSessions = False GetSessions = False
Exit Function Exit Function
End If End If
Dim FRetVal As Int32 Dim FRetVal As Int32
Dim ppSessionInfo As IntPtr = IntPtr.Zero Dim ppSessionInfo As IntPtr = IntPtr.Zero
Dim Count As Int32 = 0 Dim Count As Int32 = 0
Try Try
FRetVal = WTSEnumerateSessions(ptrOpenedServer, 0, 1, ppSessionInfo, Count) FRetVal = WTSEnumerateSessions(ptrOpenedServer, 0, 1, ppSessionInfo, Count)
If FRetVal <> 0 Then If FRetVal <> 0 Then
Dim sessionInfo() As WTS_SESSION_INFO = New WTS_SESSION_INFO(Count) {} Dim sessionInfo() As WTS_SESSION_INFO = New WTS_SESSION_INFO(Count) {}
Dim i As Integer Dim i As Integer
Dim session_ptr As System.IntPtr Dim session_ptr As System.IntPtr
For i = 0 To Count - 1 For i = 0 To Count - 1
session_ptr = ppSessionInfo.ToInt32() + (i * Marshal.SizeOf(sessionInfo(i))) session_ptr = ppSessionInfo.ToInt32() + (i * Marshal.SizeOf(sessionInfo(i)))
sessionInfo(i) = CType(Marshal.PtrToStructure(session_ptr, GetType(WTS_SESSION_INFO)), WTS_SESSION_INFO) sessionInfo(i) = CType(Marshal.PtrToStructure(session_ptr, GetType(WTS_SESSION_INFO)), WTS_SESSION_INFO)
Next Next
WTSFreeMemory(ppSessionInfo) WTSFreeMemory(ppSessionInfo)
Dim tmpArr(sessionInfo.GetUpperBound(0)) As strSessionsInfo Dim tmpArr(sessionInfo.GetUpperBound(0)) As strSessionsInfo
For i = 0 To tmpArr.GetUpperBound(0) For i = 0 To tmpArr.GetUpperBound(0)
tmpArr(i).SessionID = sessionInfo(i).SessionID tmpArr(i).SessionID = sessionInfo(i).SessionID
tmpArr(i).StationName = sessionInfo(i).pWinStationName tmpArr(i).StationName = sessionInfo(i).pWinStationName
tmpArr(i).ConnectionState = GetConnectionState(sessionInfo(i).State) tmpArr(i).ConnectionState = GetConnectionState(sessionInfo(i).State)
'MessageBox.Show(tmpArr(i).StationName & "  " & tmpArr(i).SessionID & "  " & tmpArr(i).ConnectionState) 'MessageBox.Show(tmpArr(i).StationName & " " & tmpArr(i).SessionID & " " & tmpArr(i).ConnectionState)
Next Next
ReDim sessionInfo(-1) ReDim sessionInfo(-1)
Else Else
Throw New ApplicationException("No data retruned") Throw New ApplicationException("No data retruned")
End If End If
Catch ex As Exception Catch ex As Exception
Throw New Exception(ex.Message & vbCrLf & System.Runtime.InteropServices.Marshal.GetLastWin32Error) Throw New Exception(ex.Message & vbCrLf & System.Runtime.InteropServices.Marshal.GetLastWin32Error)
End Try End Try
Catch ex As Exception Catch ex As Exception
Throw New Exception(ex.Message) Throw New Exception(ex.Message)
Exit Function Exit Function
Finally Finally
End Try End Try
'Get ProcessID of TS Session that executed this TS Session 'Get ProcessID of TS Session that executed this TS Session
Dim active_process As Int32 = GetCurrentProcessId() Dim active_process As Int32 = GetCurrentProcessId()
Dim active_session As Int32 = 0 Dim active_session As Int32 = 0
Dim success1 As Boolean = ProcessIdToSessionId(active_process, active_session) Dim success1 As Boolean = ProcessIdToSessionId(active_process, active_session)
If success1 = False Then If success1 = False Then
MessageBox.Show("Error: ProcessIdToSessionId") MessageBox.Show("Error: ProcessIdToSessionId")
End If End If
Dim returned As Integer Dim returned As Integer
Dim str As String = "" Dim str As String = ""
Dim success As Boolean = False Dim success As Boolean = False
ClientInfo.WTSStationName = "" ClientInfo.WTSStationName = ""
ClientInfo.WTSClientName = "" ClientInfo.WTSClientName = ""
ClientInfo.Address(2) = 0 ClientInfo.Address(2) = 0
ClientInfo.Address(3) = 0 ClientInfo.Address(3) = 0
ClientInfo.Address(4) = 0 ClientInfo.Address(4) = 0
ClientInfo.Address(5) = 0 ClientInfo.Address(5) = 0

'Get User Name of this TS session 'Get User Name of this TS session
If WTSQuerySessionInformation(ptrOpenedServer, active_session, WTS_INFO_CLASS.WTSUserName, str, returned) = True Then If WTSQuerySessionInformation(ptrOpenedServer, active_session, WTS_INFO_CLASS.WTSUserName, str, returned) = True Then
ClientInfo.WTSUserName = str ClientInfo.WTSUserName = str
End If End If

'Get StationName of this TS session 'Get StationName of this TS session
If WTSQuerySessionInformation(ptrOpenedServer, active_session, WTS_INFO_CLASS.WTSWinStationName, str, returned) = True Then If WTSQuerySessionInformation(ptrOpenedServer, active_session, WTS_INFO_CLASS.WTSWinStationName, str, returned) = True Then
ClientInfo.WTSStationName = str ClientInfo.WTSStationName = str
End If End If

'Get Domain Name of this TS session 'Get Domain Name of this TS session
If WTSQuerySessionInformation(ptrOpenedServer, active_session, WTS_INFO_CLASS.WTSDomainName, str, returned) = True Then If WTSQuerySessionInformation(ptrOpenedServer, active_session, WTS_INFO_CLASS.WTSDomainName, str, returned) = True Then
ClientInfo.WTSDomainName = str ClientInfo.WTSDomainName = str
End If End If

'Skip client name and client address if this is a console session 'Skip client name and client address if this is a console session
If ClientInfo.WTSStationName <> "Console" Then If ClientInfo.WTSStationName <> "Console" Then
If WTSQuerySessionInformation(ptrOpenedServer, active_session, WTS_INFO_CLASS.WTSClientName, str, returned) = True Then If WTSQuerySessionInformation(ptrOpenedServer, active_session, WTS_INFO_CLASS.WTSClientName, str, returned) = True Then
ClientInfo.WTSClientName = str ClientInfo.WTSClientName = str
End If End If

'Get client IP address 'Get client IP address
Dim addr As IntPtr Dim addr As IntPtr
If WTSQuerySessionInformation2(ptrOpenedServer, active_session, WTS_INFO_CLASS.WTSClientAddress, addr, returned) = True Then If WTSQuerySessionInformation2(ptrOpenedServer, active_session, WTS_INFO_CLASS.WTSClientAddress, addr, returned) = True Then
Dim obj As New _WTS_CLIENT_ADDRESS() Dim obj As New _WTS_CLIENT_ADDRESS()
obj = CType(Marshal.PtrToStructure(addr, obj.GetType()), _WTS_CLIENT_ADDRESS) obj = CType(Marshal.PtrToStructure(addr, obj.GetType()), _WTS_CLIENT_ADDRESS)
ClientInfo.Address(2) = obj.Address(2) ClientInfo.Address(2) = obj.Address(2)
ClientInfo.Address(3) = obj.Address(3) ClientInfo.Address(3) = obj.Address(3)
ClientInfo.Address(4) = obj.Address(4) ClientInfo.Address(4) = obj.Address(4)
ClientInfo.Address(5) = obj.Address(5) ClientInfo.Address(5) = obj.Address(5)
End If End If
End If End If
WTSCloseServer(ptrOpenedServer) WTSCloseServer(ptrOpenedServer)
Return True Return True
End Function End Function

Private Function GetConnectionState(ByVal State As WTS_CONNECTSTATE_CLASS) As String Private Function GetConnectionState(ByVal State As WTS_CONNECTSTATE_CLASS) As String
Dim RetVal As String Dim RetVal As String
Select Case State Select Case State
Case WTS_CONNECTSTATE_CLASS.WTSActive Case WTS_CONNECTSTATE_CLASS.WTSActive
RetVal = "Active" RetVal = "Active"
Case WTS_CONNECTSTATE_CLASS.WTSConnected Case WTS_CONNECTSTATE_CLASS.WTSConnected
RetVal = "Connected" RetVal = "Connected"
Case WTS_CONNECTSTATE_CLASS.WTSConnectQuery Case WTS_CONNECTSTATE_CLASS.WTSConnectQuery
RetVal = "Query" RetVal = "Query"
Case WTS_CONNECTSTATE_CLASS.WTSDisconnected Case WTS_CONNECTSTATE_CLASS.WTSDisconnected
RetVal = "Disconnected" RetVal = "Disconnected"
Case WTS_CONNECTSTATE_CLASS.WTSDown Case WTS_CONNECTSTATE_CLASS.WTSDown
RetVal = "Down" RetVal = "Down"
Case WTS_CONNECTSTATE_CLASS.WTSIdle Case WTS_CONNECTSTATE_CLASS.WTSIdle
RetVal = "Idle" RetVal = "Idle"
Case WTS_CONNECTSTATE_CLASS.WTSInit Case WTS_CONNECTSTATE_CLASS.WTSInit
RetVal = "Initializing." RetVal = "Initializing."
Case WTS_CONNECTSTATE_CLASS.WTSListen Case WTS_CONNECTSTATE_CLASS.WTSListen
RetVal = "Listen" RetVal = "Listen"
Case WTS_CONNECTSTATE_CLASS.WTSReset Case WTS_CONNECTSTATE_CLASS.WTSReset
RetVal = "reset" RetVal = "reset"
Case WTS_CONNECTSTATE_CLASS.WTSShadow Case WTS_CONNECTSTATE_CLASS.WTSShadow
RetVal = "Shadowing" RetVal = "Shadowing"
Case Else Case Else
RetVal = "Unknown connect state" RetVal = "Unknown connect state"
End Select End Select
Return RetVal Return RetVal
End Function End Function

Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim serverName As String Dim serverName As String
Dim clientInfo As New WTS_CLIENT_INFO Dim clientInfo As New WTS_CLIENT_INFO
ReDim clientInfo.Address(20) ReDim clientInfo.Address(20)
serverName = "" serverName = ""
'Server Name can be name of choice or name of server on which this application is running 'Server Name can be name of choice or name of server on which this application is running
If GetSessions(serverName, clientInfo) = True Then If GetSessions(serverName, clientInfo) = True Then
Dim str As String Dim str As String
str = "User Name: " & clientInfo.WTSUserName str = "User Name: " & clientInfo.WTSUserName
str &= vbNewLine & "Station Name: " & clientInfo.WTSStationName str &= vbNewLine & "Station Name: " & clientInfo.WTSStationName
str &= vbNewLine & "Domain Name: " & clientInfo.WTSDomainName str &= vbNewLine & "Domain Name: " & clientInfo.WTSDomainName
If clientInfo.WTSStationName <> "Console" Then If clientInfo.WTSStationName <> "Console" Then
str &= vbNewLine & "Client Name: " & clientInfo.WTSClientName str &= vbNewLine & "Client Name: " & clientInfo.WTSClientName
str &= vbNewLine & "Client IP: " & clientInfo.Address(2) & "." & clientInfo.Address(3) & "." & clientInfo.Address(4) & "." & clientInfo.Address(5) str &= vbNewLine & "Client IP: " & clientInfo.Address(2) & "." & clientInfo.Address(3) & "." & clientInfo.Address(4) & "." & clientInfo.Address(5)
End If End If
MessageBox.Show(str) MessageBox.Show(str)
End If End If
End Sub End Sub
End Class End Class