VB and VBA Users Source Code: Returning the login domain name
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Returning the login domain name
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Sunday, November 21, 2004
Hits:
2378
Category:
Networks
Article:
The function below returns the logon domain name. Option Explicit Private Type WKSTA_USER_INFO_1 wkui1_username As Long 'name of the user currently logged on to 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 NetWkstaUserGetInfo Lib "Netapi32" (ByVal reserved As Long, ByVal Level As Long, bufptr As Long) As Long Private Declare Function StrLenFromPtr Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) 'Purpose : Returns the name of the Login Domain Name. 'Inputs : N/A 'Outputs : If succeeds returns the domain name else returns an empty string 'Author : Andrew Baker 'Date : 13/Jul/2001 'Notes : Only supported on Windows NT/2000 (Requires Windows NT 3.1 or later) Public Function DomainName() As String Dim lngRet As Long Dim lngPtr As Long Dim tNTInfo As WKSTA_USER_INFO_1 On Error GoTo ErrHandler DomainName = "" lngRet = NetWkstaUserGetInfo(0&, 1&, lngPtr) If lngRet = 0 Then Call CopyMem(tNTInfo, ByVal lngPtr, LenB(tNTInfo)) If lngPtr <> 0 Then DomainName = zStringFromPtr(tNTInfo.wkui1_logon_domain) End If End If Exit Function ErrHandler: Debug.Print "Error in DomainName: " + Err.Description Debug.Assert False DomainName = "" End Function Private Function zStringFromPtr(lngPtr As Long) As String Dim lngLen As Long Dim abytStr() As Byte lngLen = StrLenFromPtr(lngPtr) * 2 If lngLen > 0 Then ReDim abytStr(0 To lngLen - 1) Call CopyMem(abytStr(0), ByVal lngPtr, lngLen) zStringFromPtr = abytStr() End If End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
