Developer.com content and product recommendations are editorially independent. We may make money when you click on links to our partners. Learn More.
Since getting my own home network this summer and playing around with NT Server, I have found many limitations on client/server machines for carrying out simple tasks. The API Viewer does not list any Winndows NT Networking API calls, but they are out there.
I dropped in on Inquiry.com’s Ask the NT Pro (LJ Johnshon) to see what they had for VB. I found quite a few examples, along with a few of my own, and I have wrapped them up into an easy to use class module called CNetworkNT.
CNetworkNT exposes eight methods for you to use NT from within your VB apps. These methods include:
AddUser – Adds a new user to the current domain
AddUserToLocal – Adds a new user to the local group
ChangePassword – Changes a password for a user
GetDomains – Lists all the domains on the current network
GetLoggedOnUsers – Returns the state of all users on the network.
GetPrimaryDCName – Returns the Primary Domain Controller computer name
Login – Login a user to the network
SetServerInfo – Sets the comment of a server on the network
The problem is that the majority of these methods use API calls that call on the netapi32.dll which is not found on most Win 95 machines, therefore a lot of the calls need to be made from NT Server or Workstation.
Either way, I am sure that you will find this class useful, I certainly have. All the API Declares, constants and type structures have been included in the same class to make it a totally drop in class module.
To create the class module, start a new Standard EXE Project and click Project, Add Class Module. Rename the class module CNetworkNT and copy/paste the following code into it:
Option Explicit
' ---------------------------------------------
' API calls
' ---------------------------------------------
Private Declare Function NetUserAdd _
Lib "netapi32.dll" (ServerName As Byte, _
ByVal Level As Long, Buffer As USER_INFO_3, _
parm_err As Long) As Long
Private Declare Function NetApiBufferAllocate _
Lib "netapi32.dll" (ByVal ByteCount As Long, _
Ptr As Long) As Long
Private Declare Function NetApiBufferFree Lib _
"Netapi32" (ByVal pBuffer As Long) As Long
Private Declare Function NetGetDCName Lib _
"netapi32.dll" (ByVal sServerName As String, _
ByVal sDomainName As String, ByVal lPtr As _
Long) As Long
Private Declare Function lstrcpyW Lib _
"kernel32.dll" (bRet As Byte, ByVal _
lPtr As Long) As Long
Private Declare Function NetLocalGroupAddMembers _
Lib "Netapi32" (ByVal psServer As Long, ByVal _
psLocalGroupName As Long, ByVal Level As Long, _
pPtrBuffer As Long, ByVal membercount As Long) As Long
Private Declare Function NetServerSetInfo Lib _
"Netapi32" (sServerName As Byte, ByVal lLevel _
As Long, vBuffer As Long, ParmError As Long) As Long
Private Declare Function LogonUser Lib "Advapi32" _
Alias "LogonUserA" (ByVal lpszUsername As String, _
ByVal lpszDomain As Any, ByVal lpszPassword As String, _
ByVal dwLogonType As Long, ByVal dwLogonProvider As _
Long, phToken As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias _
"RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal _
lSize As Long)
Private Declare Function StrLenA Lib "kernel32" Alias _
"lstrlenA" (ByVal Ptr As Long) As Long
Private Declare Function StrCopyA Lib "kernel32" Alias _
"lstrcpyA" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias _
"WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, _
ByVal dwUsage As Long, lpNetResource As Any, lppEnumHwnd _
As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias _
"WNetEnumResourceA" (ByVal pEnumHwnd As Long, lpcCount As Long, _
lpBuffer As NETRESOURCE, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal _
p_lngEnumHwnd As Long) As Long
Private Declare Function NetUserGetInfo Lib "netapi32.dll" _
(ServerName As Byte, Username As Byte, ByVal Level As Long, _
Buffer As Long) As Long
Private Declare Function NetUserEnum Lib "netapi32.dll" _
(ServerName As Byte, ByVal Level As Long, ByVal Filter _
As Long, Buffer As Long, ByVal PrefMaxLen As Long, _
EntriesRead As Long, TotalEntries As Long, ResumeHwnd _
As Long) As Long
Private Declare Function StrLenW Lib "kernel32" Alias _
"lstrlenW" (ByVal Ptr As Long) As Long
Private Declare Function NetUserChangePassword Lib _
"netapi32.dll" (ByVal domainname As String, ByVal _
Username As String, ByVal OldPassword As String, _
ByVal NewPassword As String) As Long
Private Declare Function NetUserSetInfo Lib "netapi32.dll" _
(ByVal ServerName As String, ByVal Username As String, ByVal _
Level As Long, UserInfo As Any, ParmError As Long) As Long
' ---------------------------------------------
' Possible errors with API call
' ---------------------------------------------
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const NERR_BASE As Long = 2100
Private Const NERR_GroupExists As Long = NERR_BASE + 123
Private Const NERR_NotPrimary As Long = NERR_BASE + 126
Private Const NERR_UserExists As Long = NERR_BASE + 124
Private Const NERR_PasswordTooShort As Long = NERR_BASE + 145
Private Const NERR_InvalidComputer As Long = NERR_BASE + 251
Private Const NERR_Success As Long = 0&
' ---------------------------------------------
' General constants used
' ---------------------------------------------
Private Const constUserInfoLevel3 As Long = 3
Private Const TIMEQ_FOREVER As Long = -1&
Private Const MAX_PATH As Long = 260&
Private Const DOMAIN_GROUP_RID_USERS As Long = &H201&
Private Const USER_MAXSTORAGE_UNLIMITED As Long = -1&
Private Const LocalGroupMembersInfo3 As Long = 3&
Private Const MAX_RESOURCES As Long = 256
Private Const NOT_A_CONTAINER As Long = -1
Private Const RESOURCE_GLOBALNET As Long = &H2&
Private Const RESOURCETYPE_ANY As Long = &H0&
Private Const RESOURCEUSAGE_ALL As Long = &H0&
Private Const NO_ERROR As Long = 0&
Private Const RESOURCE_ENUM_ALL As Long = &HFFFF
' ---------------------------------------------
' Constants used by LogonUser
' ---------------------------------------------
Private Const LOGON32_PROVIDER_DEFAULT As Long = 0&
Private Const LOGON32_PROVIDER_WINNT35 As Long = 1&
Private Const LOGON32_LOGON_INTERACTIVE As Long = 2&
Private Const LOGON32_LOGON_NETWORK As Long = 3&
Private Const LOGON32_LOGON_BATCH As Long = 4&
Private Const LOGON32_LOGON_SERVICE As Long = 5&
' ---------------------------------------------
' Used by usri3_flags element of data structure
' ---------------------------------------------
Private Const UF_SCRIPT As Long = &H1&
Private Const UF_ACCOUNTDISABLE As Long = &H2&
Private Const UF_HOMEDIR_REQUIRED As Long = &H8&
Private Const UF_LOCKOUT As Long = &H10&
Private Const UF_PASSWD_NOTREQD As Long = &H20&
Private Const UF_PASSWD_CANT_CHANGE As Long = &H40&
Private Const UF_DONT_EXPIRE_PASSWD As Long = &H10000
Private Const STILL_ACTIVE As Long = &H103&
Private Const UF_NORMAL_ACCOUNT As Long = &H200&
Private Const UF_SERVER_TRUST_ACCOUNT As Long = &H2000&
Private Const PROCESS_QUERY_INFORMATION As Long = &H400&
Private Const UF_TEMP_DUPLICATE_ACCOUNT As Long = &H100&
Private Const UF_INTERDOMAIN_TRUST_ACCOUNT As Long = &H800&
Private Const UF_WORKSTATION_TRUST_ACCOUNT As Long = &H1000&
' ---------------------------------------------
' The USER_INFO_3 data structure
' ---------------------------------------------
Private Type USER_INFO_3
usri3_name As Long
usri3_password As Long
usri3_password_age As Long
usri3_priv As Long
usri3_home_dir As Long
usri3_comment As Long
usri3_flags As Long
usri3_script_path As Long
usri3_auth_flags As Long
usri3_full_name As Long
usri3_usr_comment As Long
usri3_parms As Long
usri3_workstations As Long
usri3_last_logon As Long
usri3_last_logoff As Long
usri3_acct_expires As Long
usri3_max_storage As Long
usri3_units_per_week As Long
usri3_logon_hours As Long
usri3_bad_pw_count As Long
usri3_num_logons As Long
usri3_logon_server As Long
usri3_country_code As Long
usri3_code_page As Long
usri3_user_id As Long
usri3_primary_group_id As Long
usri3_profile As Long
usri3_home_dir_drive As Long
usri3_password_expired As Long
End Type
Private Type USERINFO_2_API
usri2_name As Long
usri2_password As Long
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 Type USER_INFO_10_API
Name As Long
Comment As Long
UsrComment As Long
FullName As Long
End Type
Private Type USER_INFO_1003
usri1003_password As Long
End Type
Private Type LOCALGROUP_MEMBERS_INFO_3
DomainAndName As Long
End Type
' Type used by NetServerSetInfo
Private Type SERVER_INFO_1005
sv1005_comment As Long
End Type
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
pLocalName As Long
pRemoteName As Long
pComment As Long
pProvider As Long
End Type
' *******************************************************
' Add a user either to NT -- you *MUST* have admin or
' account operator priviledges to successfully run
' this function
' Use on NT Only
' *******************************************************
Public Function AddUser(ByVal xi_strServerName As String, _
BVal xi_strUserName As String, ByVal xi_strPassword As String, _
Optional ByVal xi_strUserFullName As String = vbNullString, _
Optional ByVal xi_strUserComment As String = vbNullString) _
As Boolean
Dim p_strErr As String
Dim p_lngRtn As Long
Dim p_lngPtrUserName As Long
Dim p_lngPtrPassword As Long
Dim p_lngPtrUserFullName As Long
Dim p_lngPtrUserComment As Long
Dim p_lngParameterErr As Long
Dim p_lngFlags As Long
Dim p_abytServerName() As Byte
Dim p_abytUserName() As Byte
Dim p_abytPassword() As Byte
Dim p_abytUserFullName() As Byte
Dim p_abytUserComment() As Byte
Dim p_typUserInfo3 As USER_INFO_3
If xi_strUserFullName = vbNullString Then
xi_strUserName = xi_strUserName
End If
' ------------------------------------------
' Create byte arrays to avoid Unicode hassles
' ------------------------------------------
p_abytServerName = xi_strServerName & vbNullChar
p_abytUserName = xi_strUserName & vbNullChar
p_abytUserFullName = xi_strUserFullName & vbNullChar
p_abytPassword = xi_strPassword & vbNullChar
p_abytUserComment = xi_strUserComment & vbNullChar
' ------------------------------------------
' Allocate buffer space
' ------------------------------------------
p_lngRtn = NetApiBufferAllocate(UBound(p_abytUserName),
p_lngPtrUserName)
p_lngRtn = NetApiBufferAllocate(UBound(p_abytUserFullName),
p_lngPtrUserFullName)
p_lngRtn = NetApiBufferAllocate(UBound(p_abytPassword),
p_lngPtrPassword)
p_lngRtn = NetApiBufferAllocate(UBound(p_abytUserComment),
p_lngPtrUserComment)
' ------------------------------------------
' Get pointers to the byte arrays
' ------------------------------------------
p_lngPtrUserName = VarPtr(p_abytUserName(0))
p_lngPtrUserFullName = VarPtr(p_abytUserFullName(0))
p_lngPtrPassword = VarPtr(p_abytPassword(0))
p_lngPtrUserComment = VarPtr(p_abytUserComment(0))
' ------------------------------------------
' Fill the VB structure
' ------------------------------------------
p_lngFlags = UF_NORMAL_ACCOUNT Or _
UF_SCRIPT Or _
UF_DONT_EXPIRE_PASSWD
With p_typUserInfo3
.usri3_acct_expires = TIMEQ_FOREVER ' Never expires
.usri3_comment = p_lngPtrUserComment ' Comment
.usri3_flags = p_lngFlags ' There are a number of variations
.usri3_full_name = p_lngPtrUserFullName ' User's full name
.usri3_max_storage = USER_MAXSTORAGE_UNLIMITED ' Can use any amount
'of disk space
.usri3_name = p_lngPtrUserName ' Name of user account
.usri3_password = p_lngPtrPassword ' Password for user account
.usri3_primary_group_id = DOMAIN_GROUP_RID_USERS ' You MUST use this
'constant for NetUserAdd
.usri3_script_path = 0& ' Path of user's logon script
.usri3_auth_flags = 0& ' Ignored by NetUserAdd
.usri3_bad_pw_count = 0& ' Ignored by NetUserAdd
.usri3_code_page = 0& ' Code page for user's language
.usri3_country_code = 0& ' Country code for user's language
.usri3_home_dir = 0& ' Can specify path of home directory of this
'user
.usri3_home_dir_drive = 0& ' Drive letter assign to user's
'profile
.usri3_last_logoff = 0& ' Not needed when adding a user
.usri3_last_logon = 0& ' Ignored by NetUserAdd
.usri3_logon_hours = 0& ' Null means no restrictions
.usri3_logon_server = 0& ' Null means logon to domain server
.usri3_num_logons = 0& ' Ignored by NetUserAdd
.usri3_parms = 0& ' Used by specific applications
.usri3_password_age = 0& ' Ignored by NetUserAdd
.usri3_password_expired = 0& ' None-zero means user must change
'password at next logon
.usri3_priv = 0& ' Ignored by NetUserAdd
.usri3_profile = 0& ' Path to a user's profile
.usri3_units_per_week = 0& ' Ignored by NetUserAdd
.usri3_user_id = 0& ' Ignored by NetUserAdd
.usri3_usr_comment = 0& ' User comment
.usri3_workstations = 0& ' Workstations a user can log onto (null
'= all stations)
End With
' ------------------------------------------
' Attempt to add the user
' ------------------------------------------
p_lngRtn = NetUserAdd(p_abytServerName(0), _
constUserInfoLevel3, p_typUserInfo3, p_lngParameterErr)
' ------------------------------------------
' Check for error
' ------------------------------------------
If p_lngRtn <> 0 Then
AddUser = False
Select Case p_lngRtn
Case ERROR_ACCESS_DENIED
p_strErr = "User doesn't have sufficient access rights."
Case NERR_GroupExists
p_strErr = "The group already exists."
Case NERR_NotPrimary
p_strErr = "Can only do this operation on the PDC of the domain."
Case NERR_UserExists
p_strErr = "The user account already exists."
Case NERR_PasswordTooShort
p_strErr = "The password is shorter than required."
Case NERR_InvalidComputer
p_strErr = "The computer name is invalid."
Case Else
p_strErr = "Unknown error #" & CStr(p_lngRtn)
End Select
On Error GoTo 0
Err.Raise Number:=p_lngRtn, _
Description:=p_strErr & vbCrLf & _
"Error in parameter " & p_lngParameterErr & _
" when attempting to add the user, " & xi_strUserName, _
Source:="Form1.AddUser"
Else
AddUser = True
End If
' ------------------------------------------
' Be a good programmer and free the memory
' you've allocated
' ------------------------------------------
p_lngRtn = NetApiBufferFree(p_lngPtrUserName)
p_lngRtn = NetApiBufferFree(p_lngPtrPassword)
p_lngRtn = NetApiBufferFree(p_lngPtrUserFullName)
p_lngRtn = NetApiBufferFree(p_lngPtrUserComment)
End Function
' Works only on Win NT
Public Function GetPrimaryDCName(ByVal DName As String) As String
Dim DCName As String, DCNPtr As Long
Dim DNArray() As Byte, DCNArray(100) As Byte
Dim result As Long
DNArray = DName & vbNullChar
' Lookup the Primary Domain Controller
result = NetGetDCName(0&, DNArray(0), DCNPtr)
If result <> 0 Then
Err.Raise vbObjectError + 4000, "CNetworkInfo", result
Exit Function
End If
lstrcpyW DCNArray(0), DCNPtr
result = NetApiBufferFree(DCNPtr)
DCName = DCNArray()
GetPrimaryDCName = Left(DCName, InStr(DCName, Chr(0)) - 1)
End Function
' Use on NT Only
Public Function AddUserToLocal(ByVal xi_strGroupName As String, _
ByVal xi_strUserName As String, _
ByVal xi_strServerName As String) As Boolean
Dim p_lngPtrGroupName As Long
Dim p_lngPtrUserName As Long
Dim p_lngPtrServerName As Long
Dim p_lngMemberCount As Long
Dim p_lngRtn As Long
' Convert the server name to a pointer
If Len(Trim$(xi_strServerName)) = 0 Then
p_lngPtrServerName = 0&
Else
p_lngPtrServerName = StrPtr(xi_strServerName)
End If
' Convert the group name to a pointer
p_lngPtrGroupName = StrPtr(xi_strGroupName)
' Convert the user name to a pointer
p_lngPtrUserName = StrPtr(xi_strUserName)
' Add the user
p_lngMemberCount = 1
p_lngRtn = NetLocalGroupAddMembers(p_lngPtrServerName, _
p_lngPtrGroupName, _
LocalGroupMembersInfo3, _
p_lngPtrUserName, _
p_lngMemberCount)
If p_lngRtn = NERR_Success Then
AddUserToLocal = True
Else
AddUserToLocal = False
End If
End Function
' Works on Win 95 & NT
Public Function SetServerInfo(ByVal xi_strComment As String, _
Optional ByVal xi_strServerName As String = "") As Boolean
Dim p_bytServerName() As Byte
Dim p_lngRtn As Long
Dim p_lngSrvInfoRtn As Long
Dim p_lngServEnumLevel As Long
Dim p_lngParmError As Long
Dim p_lngStrPtr As Long
' Initialize the variables
If Trim$(xi_strServerName) = vbNullString Then
p_bytServerName = vbNullChar
Else
p_bytServerName = Trim$(xi_strServerName) & vbNullChar
End If
p_lngServEnumLevel = 1005
p_lngStrPtr = StrPtr(xi_strComment)
p_lngRtn = NetServerSetInfo(sServerName:=p_bytServerName(0), _
lLevel:=p_lngServEnumLevel, _
vBuffer:=p_lngStrPtr, _
ParmError:=p_lngParmError)
If p_lngRtn = 0 Then
SetServerInfo = True
Else
SetServerInfo = False
Debug.Print Err.LastDllError
End If
End Function
' Works on Win 95 & NT
Public Function Login(ByVal xi_strUserID As String, _
ByVal xi_strPassword As String) As Boolean
On Error Resume Next ' Don't accept errors here
Dim p_lngToken As Long
Dim p_lngRtn As Long
p_lngRtn = LogonUser(lpszUsername:=xi_strUserID, _
lpszDomain:=0&, _
lpszPassword:=xi_strPassword, _
dwLogonType:=LOGON32_LOGON_NETWORK, _
dwLogonProvider:=LOGON32_PROVIDER_DEFAULT, _
phToken:=p_lngToken)
If p_lngRtn = 0 Then
Login = False
Else
Login = True
End If
On Error GoTo 0
End Function
Private Function EnumDomains() As Variant
Dim p_lngRtn As Long
Dim p_lngEnumHwnd As Long
Dim p_lngCount As Long
Dim p_lngLoop As Long
Dim p_lngBufSize As Long
Dim p_astrDomainNames() As String
Dim p_atypNetAPI(0 To MAX_RESOURCES) As NETRESOURCE
' ------------------------------------------
' First time thru, we are just getting the root level
' ------------------------------------------
p_lngEnumHwnd = 0&
p_lngRtn = WNetOpenEnum(dwScope:=RESOURCE_GLOBALNET, _
dwType:=RESOURCETYPE_ANY, _
dwUsage:=RESOURCEUSAGE_ALL, _
lpNetResource:=ByVal 0&, _
lppEnumHwnd:=p_lngEnumHwnd)
If p_lngRtn = NO_ERROR Then
p_lngCount = RESOURCE_ENUM_ALL
p_lngBufSize = UBound(p_atypNetAPI) * Len(p_atypNetAPI(0))
p_lngRtn = WNetEnumResource(pEnumHwnd:=p_lngEnumHwnd, _
lpcCount:=p_lngCount, _
lpBuffer:=p_atypNetAPI(0), _
lpBufferSize:=p_lngBufSize)
If p_lngCount > 0 Then
For p_lngLoop = 0 To p_lngCount - 1
Debug.Print PointerToAsciiStr(p_atypNetAPI(p_lngLoop).pRemoteName)
Next p_lngLoop
End If
End If
If p_lngEnumHwnd <> 0 Then
Call WNetCloseEnum(p_lngEnumHwnd)
End If
' ------------------------------------------
' Now we are going for the second level,
' which should contain the domain names
' ------------------------------------------
p_lngRtn = WNetOpenEnum(dwScope:=RESOURCE_GLOBALNET, _
dwType:=RESOURCETYPE_ANY, _
dwUsage:=RESOURCEUSAGE_ALL, _
lpNetResource:=p_atypNetAPI(0), _
lppEnumHwnd:=p_lngEnumHwnd)
If p_lngRtn = NO_ERROR Then
p_lngCount = RESOURCE_ENUM_ALL
p_lngBufSize = UBound(p_atypNetAPI) * Len(p_atypNetAPI(0))
p_lngRtn = WNetEnumResource(pEnumHwnd:=p_lngEnumHwnd, _
lpcCount:=p_lngCount, _
lpBuffer:=p_atypNetAPI(0), _
lpBufferSize:=p_lngBufSize)
If p_lngCount > 0 Then
ReDim p_astrDomainNames(1 To p_lngCount) As String
For p_lngLoop = 0 To p_lngCount - 1
p_astrDomainNames(p_lngLoop + 1) =
PointerToAsciiStr(p_atypNetAPI(p_lngLoop).pRemoteName)
Next p_lngLoop
End If
End If
If p_lngEnumHwnd <> 0 Then
Call WNetCloseEnum(p_lngEnumHwnd)
End If
' ------------------------------------------
' Set the return value
' ------------------------------------------
EnumDomains = p_astrDomainNames
End Function
Private Function PointerToAsciiStr(ByVal xi_lngPtrToString As _
Long) As String
On Error Resume Next ' Don't accept an error here
Dim p_lngLen As Long
Dim p_strStringValue As String
Dim p_lngNullPos As Long
Dim p_lngRtn As Long
p_lngLen = StrLenA(xi_lngPtrToString)
If xi_lngPtrToString > 0 And p_lngLen > 0 Then
p_strStringValue = Space$(p_lngLen + 1)
p_lngRtn = StrCopyA(p_strStringValue, xi_lngPtrToString)
p_lngNullPos = InStr(p_strStringValue, Chr$(0)
If p_lngNullPos > 0 Then
'Lose the null terminator...
PointerToAsciiStr = Left$(p_strStringValue, p_lngNullPos - 1)
Else
PointerToAsciiStr = p_strStringValue 'Just pass the string...
End If
Else
PointerToAsciiStr = ""
End If
End Function
' Works on Win 95 & NT
Public Sub GetDomains(lst As Object)
Dim p_avntDomains As Variant
Dim p_lngLoop As Long
Dim p_lngNumItems As Long
p_avntDomains = EnumDomains()
On Error Resume Next
p_lngNumItems = UBound(p_avntDomains)
On Error GoTo 0
If p_lngNumItems > 0 Then
For p_lngLoop = 1 To p_lngNumItems
' Debug.Print "Domain Name: " & p_avntDomains(p_lngLoop)
lst.AddItem p_avntDomains(p_lngLoop)
Next p_lngLoop
End If
End Sub
' Works on Win NT only
Public Function GetLoggedOnUsers(ByVal ServerName As _
String) As Variant
Dim p_lngRtn As Long
Dim p_lngPtrBuffer As Long
Dim p_lngPtrUserInfoBuf As Long
Dim p_lngEntriesRead As Long
Dim p_lngTotalEntries As Long
Dim p_lngResumeHwnd As Long
Dim p_lngLoop As Long
Dim p_lngLastLogon As Long
Dim p_lngLastLogoff As Long
Dim p_strUserName As String
Dim p_abytServerName() As Byte
Dim p_abytUserName() As Byte
Dim p_atypUserInfo() As USER_INFO_10_API
Dim p_typUserInfo As USERINFO_2_API
' ------------------------------------------
' Initialize the variable(s)
' ------------------------------------------
If ServerName = "" Then
p_abytServerName = Chr$(0)
Else
p_abytServerName = "" & ServerName & Chr$(0)
End If
' ------------------------------------------
' Make appropriate API call and check for error
' ------------------------------------------
p_lngRtn = NetUserEnum(ServerName:=p_abytServerName(0), _
Level:=10, _
Filter:=0&, _
Buffer:=p_lngPtrBuffer, _
PrefMaxLen:=&H4000, _
EntriesRead:=p_lngEntriesRead, _
TotalEntries:=p_lngTotalEntries, _
ResumeHwnd:=p_lngResumeHwnd)
If p_lngRtn <> 0 Then
MsgBox "Had an error with NetUserEnum, " &
CStr(p_lngRtn), _
Buttons:=vbInformation, _
Title:="GetLoggedOnUsers"
Exit Function
End If
' ------------------------------------------
' Exit if no entries found
' ------------------------------------------
If p_lngEntriesRead < 1 Then
Exit Function
End If
' ------------------------------------------
' Redim the type array to hold this info
' ------------------------------------------
ReDim p_atypUserInfo(0 To p_lngEntriesRead - 1)
' ------------------------------------------
' Copy the pointer to the buffer into the
' type array
' ------------------------------------------
CopyMem p_atypUserInfo(0), _
ByVal p_lngPtrBuffer, _
Len(p_atypUserInfo(0)) * p_lngEntriesRead
' ------------------------------------------
' Fill-in the info needed to call the
' Add() method
' NOTE: We will always have +1 open pipe,
' since in making this call we create
' a pipe, "PIPEsrvsvc"
' ------------------------------------------
For p_lngLoop = 0 To p_lngEntriesRead - 1
p_strUserName = PointerToUnicodeStr(p_atypUserInfo(p_lngLoop).Name)
p_abytUserName = p_strUserName & Chr(0)
p_lngRtn = NetUserGetInfo(ServerName:=p_abytServerName(0), _
Username:=p_abytUserName(0), _
Level:=2, _
Buffer:=p_lngPtrUserInfoBuf)
If p_lngRtn <> 0 Then
MsgBox "Had an error with NetUserGetInfo, " &
CStr(p_lngRtn), _
Buttons:=vbInformation, _
Title:="GetLoggedOnUsers"
Exit Function
End If
CopyMem p_typUserInfo, _
ByVal p_lngPtrUserInfoBuf, _
Len(p_typUserInfo)
p_lngLastLogon = p_typUserInfo.usri2_last_logon
p_lngLastLogoff = p_typUserInfo.usri2_last_logoff
If p_lngLastLogoff = 0 And p_lngLastLogon = 0 Then
MsgBox " **** " & p_strUserName & " has NEVER logged in"
ElseIf (p_lngLastLogoff < p_lngLastLogon) Then
MsgBox p_strUserName & " is still logged in -- " &
p_lngLastLogoff, p_lngLastLogon
Else
MsgBox " **** " & p_strUserName & " is NOT logged in"
End If
If p_lngPtrUserInfoBuf <> 0 Then
NetApiBufferFree p_lngPtrUserInfoBuf
End If
Next p_lngLoop
' ------------------------------------------
' Clean-up the buffer
' ------------------------------------------
If p_lngPtrBuffer <> 0 Then
NetApiBufferFree p_lngPtrBuffer
End If
End Function
Private Function PointerToUnicodeStr(lpUnicodeStr As Long) As String
On Error Resume Next ' Don't accept an error here
Dim Buffer() As Byte
Dim nLen As Long
If lpUnicodeStr Then
nLen = StrLenW(lpUnicodeStr) * 2
If nLen Then
ReDim Buffer(0 To (nLen - 1)) As Byte
' ------------------------------------
' Copy the pointer to the buffer into
' the type array
' ------------------------------------
CopyMem Buffer(0), ByVal lpUnicodeStr, nLen
PointerToUnicodeStr = Buffer
End If
End If
End Function
' Use on NT Only
Public Function ChangePassword(strUserName As String, _
strDomain As String, strOldPwl As String, _
strNewPwl As String) As Boolean
Dim sServer As String, sUser As String
Dim sNewPass As String, sOldPass As String
Dim UI1003 As USER_INFO_1003
Dim dwLevel As Long
Dim lRet As String
Dim sNew As String
' StrConv Functions are necessary since VB will perform
' UNICODE/ANSI translation before passing strings to the
' NETAPI functions
sUser = StrConv(strUserName, vbUnicode)
sNewPass = StrConv(strNewPwl, vbUnicode)
'See if this is Domain or Computer referenced
If Left(strDomain, 2) = "" Then
sServer = StrConv(strDomain, vbUnicode)
Else
' Domain was referenced, get the Primary Domain Controller
sServer = StrConv(GetPrimaryDCName(strDomain), vbUnicode)
End If
If strOldPwl = "" Then
' Administrative over-ride of existing password.
' Does not require old password
dwLevel = 1003
sNew = strNewPwl
UI1003.usri1003_password = StrPtr(sNew)
lRet = NetUserSetInfo(sServer, sUser, dwLevel, UI1003, 0&)
Else
' Set the Old Password and attempt to change the user's password
sOldPass = StrConv(strOldPwl, vbUnicode)
lRet = NetUserChangePassword(sServer, sUser, sOldPass, sNewPass)
End If
If lRet <> 0 Then
ChangePassword = False
Else
ChangePassword = True
End If
End Function
I couldn’t be bothered to put the code up here for the test form, because there are about 10 different command buttons. But you can get the test form in the download below.
