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
```
页:
[1]