如何从 VBA 获取当前登录的 Active Directory 用户名?
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/1574777/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How do I get the current logged in Active Directory username from VBA?
提问by Kuyenda
I am new to Active Directory.
我是 Active Directory 的新手。
I have a VBA Excel Add-In that should run if, and only if, the computer that it is running on is currently logged into the Active Directory, whether locally or through a VPN.
我有一个 VBA Excel 加载项,当且仅当运行它的计算机当前登录到 Active Directory(本地或通过 VPN)时,它才应该运行。
Knowing the domain name, how would I retrieve the user name for the currently logged in user?
知道域名后,如何获取当前登录用户的用户名?
Thanks!
谢谢!
回答by willmichels
I know it's kinda late, but I went through hell last year to find the following code, that can return the username ("fGetUserName()") or the full name ("DragUserName()"). You don't even need to know the ad / dc address..
我知道现在有点晚了,但去年我经历了地狱,找到了以下代码,它可以返回用户名(“fGetUserName()”)或全名(“DragUserName()”)。你甚至不需要知道广告/直流地址..
Hope this is helpful to anyone who consults this question.
希望这对咨询此问题的任何人都有帮助。
Private Type USER_INFO_2
usri2_name As Long
usri2_password As Long ' Null, only settable
usri2_password_age As Long
usri2_priv As Long
usri2_home_dir As Long
usri2_comment As Long
usri2_flags As Long
usri2_script_path As Long
usri2_auth_flags As Long
usri2_full_name As Long
usri2_usr_comment As Long
usri2_parms As Long
usri2_workstations As Long
usri2_last_logon As Long
usri2_last_logoff As Long
usri2_acct_expires As Long
usri2_max_storage As Long
usri2_units_per_week As Long
usri2_logon_hours As Long
usri2_bad_pw_count As Long
usri2_num_logons As Long
usri2_logon_server As Long
usri2_country_code As Long
usri2_code_page As Long
End Type
Private Declare Function apiNetGetDCName Lib "Netapi32.dll" Alias "NetGetDCName" (ByVal servername As Long, ByVal DomainName As Long, bufptr As Long) As Long
Private Declare Function apiNetAPIBufferFree Lib "Netapi32.dll" Alias "NetApiBufferFree" (ByVal buffer As Long) As Long
Private Declare Function apilstrlenW Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function apiNetUserGetInfo Lib "Netapi32.dll" Alias "NetUserGetInfo" (servername As Any, UserName As Any, ByVal level As Long, bufptr As Long) As Long
Private Declare Sub sapiCopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32.dll" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private strUserID As String
Private strUserName As String
Private strComputerName As String
Private Const MAXCOMMENTSZ = 256
Private Const NERR_SUCCESS = 0
Private Const ERROR_MORE_DATA = 234&
Private Const MAX_CHUNK = 25
Private Const ERROR_SUCCESS = 0&
Public Function fGetUserName() As String
' Returns the network login name
Dim lngLen As Long, lngRet As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngRet = apiGetUserName(strUserName, lngLen)
If lngRet Then
fGetUserName = Left$(strUserName, lngLen - 1)
End If
End Function
Private Sub Class_Initialize()
On Error Resume Next
'Returns the network login name
Dim strTempUserID As String, strTempComputerName As String
'Create a buffer
strTempUserID = String(100, Chr$(0))
strTempComputerName = String(100, Chr$(0))
'Get user name
GetUserName strTempUserID, 100
'Get computer name
GetComputerName strTempComputerName, 100
'Strip the rest of the buffer
strTempUserID = Left$(strTempUserID, InStr(strTempUserID, Chr$(0)) - 1)
Let strUserID = LCase(strTempUserID)
strTempComputerName = Left$(strTempComputerName, InStr(strTempComputerName, Chr$(0)) - 1)
Let strComputerName = LCase(strTempComputerName)
Let strUserName = DragUserName(strUserID)
End Sub
Public Property Get UserID() As String
UserID = strUserID
End Property
Public Property Get UserName() As String
UserName = strUserName
End Property
Public Function DragUserName(Optional strUserName As String) As String
On Error GoTo ErrHandler
Dim pBuf As Long
Dim dwRec As Long
Dim pTmp As USER_INFO_2
Dim abytPDCName() As Byte
Dim abytUserName() As Byte
Dim lngRet As Long
Dim i As Long
' Unicode
abytPDCName = fGetDCName() & vbNullChar
If strUserName = "" Then strUserName = fGetUserName()
abytUserName = strUserName & vbNullChar
' Level 2
lngRet = apiNetUserGetInfo( _
abytPDCName(0), _
abytUserName(0), _
2, _
pBuf)
If (lngRet = ERROR_SUCCESS) Then
Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
DragUserName = fStrFromPtrW(pTmp.usri2_full_name)
End If
Call apiNetAPIBufferFree(pBuf)
ExitHere:
Exit Function
ErrHandler:
DragUserName = vbNullString
Resume ExitHere
End Function
Public Property Get ComputerName() As String
ComputerName = strComputerName
End Property
Private Sub Class_Terminate()
strUserName = ""
strComputerName = ""
End Sub
Public Function fGetDCName() As String
Dim pTmp As Long
Dim lngRet As Long
Dim abytBuf() As Byte
lngRet = apiNetGetDCName(0, 0, pTmp)
If lngRet = NERR_SUCCESS Then
fGetDCName = fStrFromPtrW(pTmp)
End If
Call apiNetAPIBufferFree(pTmp)
End Function
Public Function fStrFromPtrW(pBuf As Long) As String
Dim lngLen As Long
Dim abytBuf() As Byte
' Get the length of the string at the memory location
lngLen = apilstrlenW(pBuf) * 2
' if it's not a ZLS
If lngLen Then
ReDim abytBuf(lngLen)
' then copy the memory contents
' into a temp buffer
Call sapiCopyMem( _
abytBuf(0), _
ByVal pBuf, _
lngLen)
' return the buffer
fStrFromPtrW = abytBuf
End If
End Function
回答by Alex Beardsley
EDITED:If I understand your situation properly, then you might be going about this the wrong way.
编辑:如果我正确理解你的情况,那么你可能会以错误的方式处理这个问题。
When your app starts up, you could do a simple ping against a machine that the user would only be able to see if they were connected to your network, whether they log into the local network or if they are connected via the VPN.
当您的应用程序启动时,您可以对一台机器执行简单的 ping 操作,用户只能看到他们是否已连接到您的网络、是否登录到本地网络或是否通过 VPN 连接。
If they already have access to your local network, it means they've already authenticated against whatever machanism, whether it's Active Directory or something else, and it means they are "currently logged in".
如果他们已经可以访问您的本地网络,则意味着他们已经针对任何机制(无论是 Active Directory 还是其他机制)进行了身份验证,这意味着他们“当前已登录”。
On a side note, Active Directory by itself doesn't know if someone is logged in. There's no way you can do something like:
附带说明一下,Active Directory 本身不知道是否有人登录。您无法执行以下操作:
ActiveDirectory.getIsThisUserLoggedIn("username");
Active Directory only acts as a mechanism for user metadata, security, and authentication.
Active Directory 仅充当用户元数据、安全性和身份验证的机制。
回答by Rubens Farias
Try this
尝试这个
MsgBox Environ("USERNAME")
回答by pyOwner
This function returns full name of logged user:
此函数返回登录用户的全名:
Function UserNameOffice() As String
UserNameOffice = Application.UserName
End Function