Option Compare Database
Option Explicit
Private Type WKSTA_USER_INFO_1
wkui1_username As Long 'name of the user currently logged onto the workstation.
wkui1_logon_domain As Long 'the domain name of the user account of the user currently logged on
wkui1_oth_domains As Long 'list of other LAN Manager domains browsed by the workstation.
wkui1_logon_server As Long 'name of the computer that authenticated the server
End Type
Private Declare Function apiWkStationUser Lib "Netapi32" _
Alias "NetWkstaUserGetInfo" (ByVal reserved As Long, ByVal Level As Long, bufptr As Long) As Long
Private Declare Function apiStrLenFromPtr Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Sub sapiCopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Function UsersNetworkName() As String
On Error GoTo ErrHandler
Dim lngRet As Long
Dim lngPtr As Long
Dim tUsersNetworkName As WKSTA_USER_INFO_1
lngRet = apiWkStationUser(0&, 1&, lngPtr)
If lngRet = 0 Then
Call sapiCopyMemory(tUsersNetworkName, ByVal lngPtr, LenB(tUsersNetworkName))
If Not lngPtr = 0 Then
With tUsersNetworkName
UsersNetworkName = StringFromPtr(.wkui1_username)
End With
End If
End If
ExitHere:
Exit Function
ErrHandler:
UsersNetworkName = vbNullString
Resume ExitHere
End Function
Public Function UserNTDomain() As String
On Error GoTo ErrHandler
Dim lngRet As Long
Dim lngPtr As Long
Dim tNTInfo As WKSTA_USER_INFO_1
lngRet = apiWkStationUser(0&, 1&, lngPtr)
If lngRet = 0 Then
Call sapiCopyMemory(tNTInfo, ByVal lngPtr, LenB(tNTInfo))
If Not lngPtr = 0 Then
With tNTInfo
UserNTDomain = StringFromPtr(.wkui1_logon_domain)
End With
End If
End If
ExitHere:
Exit Function
ErrHandler:
UserNTDomain = vbNullString
Resume ExitHere
End Function
Public Function LogonServer() As String
On Error GoTo ErrHandler
Dim lngRet As Long
Dim lngPtr As Long
Dim tComputerInfo As WKSTA_USER_INFO_1
lngRet = apiWkStationUser(0&, 1&, lngPtr)
If lngRet = 0 Then
Call sapiCopyMemory(tComputerInfo, ByVal lngPtr, LenB(tComputerInfo))
If Not lngPtr = 0 Then
With tComputerInfo
LogonServer = StringFromPtr(.wkui1_logon_server)
End With
End If
End If
ExitHere:
Exit Function
ErrHandler:
LogonServer = vbNullString
Resume ExitHere
End Function
Private Function StringFromPtr(lngPtr As Long) As String
Dim lngLen As Long
Dim abytStr() As Byte
lngLen = apiStrLenFromPtr(lngPtr) * 2
If lngLen > 0 Then
ReDim abytStr(0 To lngLen - 1)
Call sapiCopyMemory(abytStr(0), ByVal lngPtr, lngLen)
StringFromPtr = abytStr()
End If
End Function
Private Sub Form_Open(Cancel As Integer)
tbUserNTDomain = UserNTDomain()
tbUsersNetworkName = UsersNetworkName()
tbLogonServer = LogonServer()
End Sub