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.