基本信息

---

下载

   友情提示：（无需注册或充值，赞助后即可获取资源下载链接）

---

     嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：813200300

本次赞助数额为： 2 元　

支付宝支付

微信支付

   源码介绍

---

Public Class Form1
    Private Declare Auto Function WTSQuerySessionInformation Lib "wtsapi32.dll" ( _
            ByVal hServer As Int32, _
            ByVal SessionId As Int32, _
            ByVal InfoClass As WTSInfoClass, _
            ByRef ppBuffer As IntPtr, _
            ByRef pCount As Int32) As Boolean

    Private Declare Function GetCurrentProcessId Lib "Kernel32.dll" () As Integer
    Private Declare Sub ProcessIdToSessionId Lib "Kernel32.dll" (ByVal lngPID As Integer, ByRef lngSID As Integer)
    Private Declare Sub WTSFreeMemory Lib "wtsapi32.dll" (ByVal pMemory As Integer)

    <System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Sequential)> _
    Public Structure WTS_CLIENT_ADDRESS
        Public AddressFamily As Integer
        <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=20)> _
        Public Address As Byte()
    End Structure

    Public Enum WTSInfoClass
        WTSInitialProgram
        WTSApplicationName
        WTSWorkingDirectory
        WTSOEMID
        WTSSessionId
        WTSUserName
        WTSWinStationName
        WTSDomainName
        WTSConnectState
        WTSClientBuilderNumber
        WTSClientName
        WTSClientDirectory
        WTSClientProductId
        WTSClientHardwareId
        WTSClientAddress
        WTSClientDisplay
        WTSClientProtocolType
    End Enum

    Private Const WTS_CURRENT_SERVER_HANDLE As Integer = 0
    Private WTS_CURRENT_SESSION As Integer

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        Dim lngPID As Integer = GetCurrentProcessId

        ProcessIdToSessionId(lngPID, WTS_CURRENT_SESSION)

        Dim lpBufferP As IntPtr
        Dim ClientAddress As New WTS_CLIENT_ADDRESS()
        Dim RetVal As Boolean
        Dim Count As Integer

        RetVal = WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, WTS_CURRENT_SESSION, WTSInfoClass.WTSClientAddress, lpBufferP, Count)

        If CBool(RetVal) Then

            ClientAddress = CType(System.Runtime.InteropServices.Marshal.PtrToStructure(lpBufferP, ClientAddress.GetType()), WTS_CLIENT_ADDRESS)
            
            WTSFreeMemory(CInt(lpBufferP))        

        End If

        Dim IPAddress As String = Trim(ClientAddress.Address(2) & "." & ClientAddress.Address(3) & "." & ClientAddress.Address(4) & "." & ClientAddress.Address(5))

    End Sub
End Class