Blog
Reading IPv6 address (AF_INET6) from WTSQuerySessionInformation in VB6
Solved: How to retrieve IPv6 address from WTSQuerySessionInformation in VB6 when WTS_CLIENT_ADDRESS.AddressFamily returns AF_INET6.
As none of the old forum posts asking about how to get an IPv6 address from WTSQuerySessionInformation in VB6 give the solution I thought it worth posting.
This fills in the gap where WTS_CLIENT_ADDRESS.AddressFamily returns AF_INET6. Luckily the coding of the IP address is as simple as with IPv4; the IPv6 address is stored using 16 bytes starting at the 3rd byte.
Private Const WTS_CURRENT_SERVER_HANDLE = 0&
'Structure for TS Client IP Address
Private Type WTS_CLIENT_ADDRESS
AddressFamily As Long
Address(0 To 19) As Byte
End Type
Private Const AF_UNSPEC = 0
Private Const AF_INET = 2 'IPv4
Private Const AF_INET6 = 23 'IPv6
Private Enum WTS_INFO_CLASS
WTSInitialProgram
WTSApplicationName
WTSWorkingDirectory
WTSOEMId
WTSSessionId
WTSUserName
WTSWinStationName
WTSDomainName
WTSConnectState
WTSClientBuildNumber
WTSClientName
WTSClientDirectory
WTSClientProductId
WTSClientHardwareId
WTSClientAddress
WTSClientDisplay
WTSClientProtocolType
WTSIdleTime
WTSLogonTime
WTSIncomingBytes
WTSOutgoingBytes
WTSIncomingFrames
WTSOutgoingFrames
WTSClientInfo '23
End Enum
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function ProcessIdToSessionId Lib "Kernel32.dll" (ByVal ProcessID As Long, ByRef SessionID As Long) As Boolean
Private Declare Function WTSQuerySessionInformation Lib "wtsapi32" Alias "WTSQuerySessionInformationA" (ByVal hServer As Long, ByVal lSessionID As Long, ByVal aeClass As WTS_INFO_CLASS, ByRef apBuffer As Long, ByRef lNumBytes As Long) As Boolean
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Function GetTsClientIpAddress() As String
Dim ProcessID As Long, SessionID As Long
'Get the ID of the current process
ProcessID = GetCurrentProcessId(): SessionID = 0
'Get the TS/RDS Session ID that the process is running in
If ProcessIdToSessionId(ProcessID, SessionID) Then
Dim lpBuffer As Long, BufSize As Long
lpBuffer = 0: BufSize = 0
'Call out to get WTSClientAddress
If WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, SessionID, WTS_INFO_CLASS.WTSClientAddress, lpBuffer, BufSize) Then
'Copy the returned memory into our WTS_CLIENT_ADDRESS object
Dim obj As WTS_CLIENT_ADDRESS
CopyMemory obj, ByVal lpBuffer, LenB(obj)
'Check what address family we get back (AF_INET = IPv4, AF_INET6 = IPv6)
Select Case obj.AddressFamily
Case AF_INET
'Reconstruct the IPv4 address from bytes 3 to 6 (of 20)
GetTsClientIpAddress = obj.Address(2) & "." & obj.Address(3) & "." & obj.Address(4) & "." & obj.Address(5)
Case AF_INET6
Dim strIPv6 As String, i As Integer, j As Integer, SingleVal As String, HexVal As String
strIPv6 = ""
'Reconstruct the IPv6 Address from bytes 3 to 18 (of 20)
For i = 2 To 17 Step 2
HexVal = ""
'Read out in pairs of bytes
For j = 0 To 1
SingleVal = CStr(Hex(obj.Address(i + j)))
'Add leading zeros to the Hex value as required
If Len(SingleVal) = 1 Then SingleVal = "0" + SingleVal
HexVal = HexVal + SingleVal
Next
'Add a colon if this is the second or subsequent block
If Len(strIPv6) > 0 Then HexVal = ":" + HexVal
'Add the 4 character hex value
strIPv6 = strIPv6 + HexVal
Next
'TODO: If required, reduce the address, removing any leading zeros and replacing the largest block of consecutive 0:0 with ::
'Return the IPv6 address
GetTsClientIpAddress = strIPv6
End Select
End If
End If
End Function
I have left the reduction of the IPv6 address (e.g. from 0000:0000:0000:0000:0000:0000:0000:0001 to ::1) up to the reader!
Under Terminal Services (TS) Gateway / Remote Desktop Services (RDS) Gateway, the call to WTSQuerySessionInformation above appears to return AF_UNSPEC. It may be worth trying to request WTSClientInfo in this case (and copy it to an appropriate WTSCLIENT structure), but I have not tried this so do not know what the result would be.
By Theo Gray on May 21, 2013 | Permalink | Comment
RSS feed
Reader Comments
Skip to form
February 4, 2019
,I says:Thanks a lot!