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




Reply With Quote
