This code will let you find the IP Address of the user's machine if he is running the app over a Citrix thin client. Also works with Remote Desktop.
Code:
Option Explicit
Private Const WTS_CURRENT_SERVER_HANDLE = 0&
Private WTS_CURRENT_SESSION As Long
Private Type WTS_CLIENT_ADDRESS
AddressFamily As Long
Address(20) As Byte
End Type
Private Declare Function WTSQuerySessionInformation _
Lib "wtsapi32" Alias "WTSQuerySessionInformationW" ( _
ByVal hServer As Long, _
ByVal SessionID As Long, _
ByVal WTSInfoClass As Long, _
ByRef Address As Long, _
ByRef pBytesReturned As Long _
) As Long
Enum WTSInfoClass
WTSInitialProgram
WTSApplicationName
WTSWorkingDirectory
WTSOEMId
WTSSessionId
WTSUserName
WTSWinStationName
WTSDomainName
WTSConnectState
WTSClientBuildNumber
WTSClientName
WTSClientDirectory
WTSClientProductId
WTSClientHardwareId
WTSClientAddress
WTSClientDisplay
WTSClientProtocolType
End Enum
Private Declare Sub WTSFreeMemory Lib "wtsapi32.dll" ( _
ByVal pMemory As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Private Declare Function GetCurrentProcessId Lib "Kernel32.dll" () As Long
Private Declare Sub ProcessIdToSessionId Lib "Kernel32.dll" (ByVal lngPID As Long, ByRef lngSID As Long)
Private lngPID As Long
Private Sub Command1_Click()
Text1.Text = "Client IP " & GetClientIPAddress
End Sub
Public Function GetClientIPAddress() As String
Dim RetVal As Long
Dim TmpAddress As WTS_CLIENT_ADDRESS
Dim ByteRet As Long
Dim lpBuffer As Long
Dim p As Long
' get the id of current process running
lngPID = GetCurrentProcessId
' get the session id in which this process is running
ProcessIdToSessionId lngPID, WTS_CURRENT_SESSION
' user the current server, session id to trap the other details
RetVal = WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, WTS_CURRENT_SESSION, WTSClientAddress, lpBuffer, ByteRet)
If RetVal Then
' WTSQuerySessionInfo was successful.
p = lpBuffer
CopyMemory TmpAddress, ByVal p, ByteRet
' Free the memory buffer.
WTSFreeMemory lpBuffer
Else
GetClientIPAddress = ""
Err.Raise Err.Number, Err.Source, "Error with the wtsQuerySessionInfo command " & Err.LastDllError
End If
GetClientIPAddress = Trim(TmpAddress.Address(2) & "." & TmpAddress.Address(3) & "." & TmpAddress.Address(4) & "." & TmpAddress.Address(5))
End Function