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