To retrieve the current time from a NT server, we can use the
NetWkStaUserGetInfo API function.
Note: NetWkStaUserGetInfo, as with a whole bunch of other API
functions, exist only under Windows NT environment. So this code will NOT
work in Windows 95 or 98.
Private Type WKSTA_USER_INFO_1
wkui1_username As Long
currently logged on _
to the workstation.
wkui1_logon_domain As Long
the user account of the _
user currently logged on
wkui1_oth_domains As Long
Manager domains browsed _
by the workstation.
wkui1_logon_server As Long
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 fUserNTDomain() 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
fUserNTDomain = fStringFromPtr(.wkui1_logon_domain)
End With
End If
End If
ExitHere:
Exit Function
ErrHandler:
fUserNTDomain = vbNullString
Resume ExitHere
End Function
Private Function fStringFromPtr(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)
fStringFromPtr = abytStr()
End If
End Function
|