VB6取远程桌面访问者的客户端电脑IP，如何获取电脑是否在锁屏状态？

逍遥爱迪生

VB6取远程桌面访问者的客户端电脑IP
如何获取电脑是否在锁屏状态？

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

Private 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

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
Public Function GetWTSConnectState() As Boolean '有问题，如何得到锁屏状态》
    Dim RetVal As Long
    Dim lConnectState As Long
    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, WTSConnectState, lpBuffer, ByteRet)

    If RetVal Then
        ' WTSQuerySessionInfo was successful.
        p = lpBuffer
        CopyMemory lConnectState, ByVal p, ByteRet

        GetWTSConnectState = lConnectState = 4 'WTSDisconnected
        ' Free the memory buffer.
        WTSFreeMemory lpBuffer
    Else
        Err.Raise Err.Number, Err.Source, "Error with the wtsQuerySessionInfo command " & Err.LastDllError
    End If

End Function