Local User and Group Management with VBScript and ADSI

User management for Windows machines can be complicated and convoluted sometimes. Because pretty much everything I do is to make life easier for me, I decided to write some basic functions that can reliably add, delete, change passwords and simply check to see if a particular user exists.

I had a couple of requirements when writing these functions. All of these functions should have at least some error checking to ensure that the user we create or delete is actually created or deleted and if we encounter an error we don’t want to return a success code. So I coded all that into these functions too so that if everything went as planned when you called the function, the function returns “True”. If you encountered an error the function returns “False”.

I thought about creating another function that would edit all of the available flags for each user but couldn’t think of a way to make it easy and pack it into a simple function. I may dream something up and add it to this list of functions in the near future but if anyone reads this and has something please feel free to submit it!

The collective list of functions is:

CreateUser – Creates a local user.
DeleteUser – Deletes a local user.
ChangePassword – Changes the password to the one specified.
RndPassword – Creates a random strong password of variable length.
UserExists – Checks to see if the local user exists.
CreateGroup – Creates a local group.
DeleteGroup – Deletes a local group.
GroupExists – Checks to see if the local group exists.
AddUserToGroup – Adds a local user to the local group specified.
RemoveUserFromGroup – Removes a local user from the local group specified.

' You can roll these constants into the functions if you want to pack everything
' into one function or set of functions. Or you can delete the constant statements
' and simply pass the values instead.

CONST ADS_UF_SCRIPT = &H0001                   '  Logon script will be executed
CONST ADS_UF_ACCOUNTDISABLE = &H0002           '  Account is disabled
CONST ADS_UF_HOMEDIR_REQUIRED = &H0008         '  Account requires a home directory
CONST ADS_UF_LOCKOUT = &H0010                  '  Account is locked out
CONST ADS_UF_PASSWD_NOTREQD = &H0020           '  Account does not require a password
CONST ADS_UF_PASSWD_CANT_CHANGE = &H0040       '  User cannot change password
CONST ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = &H0080 '  Encrypted text password
                                                      ' allowed
CONST ADS_UF_DONT_EXPIRE_PASSWD = &H10000      '  Account password never expires
CONST ADS_UF_SMARTCARD_REQUIRED = &H40000      '  Smartcard required for logon
CONST ADS_UF_PASSWORD_EXPIRED = &H800000       '  Password has expired


Function CreateUser(sUserName, sPassword, sDescription)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com

  If UserExists(sUserName) Then
    CreateUser = False
    Exit Function
  End If

  On Error Resume Next

  Set oNetwork = CreateObject("WScript.Network")
  sComputerName = oNetwork.Computername
  Set oContainer = GetObject("WinNT://" & sComputerName)
  set oNewUser = oContainer.Create("user", sUserName)
  oNewUser.SetPassword(sPassword)

  ' Set additional flags.
  oNewUser.put "UserFlags", ADS_UF_DONT_EXPIRE_PASSWD OR ADS_UF_PASSWD_CANT_CHANGE
  oNewUser.Description = sDescription

  oNewUser.SetInfo

  If Err.Number = 0 then
    If UserExists(sUserName) Then
      CreateUser = True
    Else
      CreateUser = False
    End If
  Else
    CreateUser = False
  End If

  On Error Goto 0  

End Function

Function DeleteUser(sUserName)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com

  If Not UserExists(sUserName) Then
    DeleteUser = False
    Exit Function
  End If

  On Error Resume Next

  Set oNetwork = CreateObject("WScript.Network")
  sComputerName = oNetwork.Computername
  Set oContainer = GetObject("WinNT://" & sComputerName)
  oContainer.Delete "user", sUserName

  If Err.Number = 0 then
    If UserExists(sUserName) Then
      DeleteUser = False
    Else
      DeleteUser = True
    End IF
  Else
    DeleteUser = False
  End If

  On Error Goto 0

End Function

Function UserExists(sUserName)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com

  'Returns True or False based on if the local user
  'exists.

  Set oNetwork = CreateObject("WScript.Network")
  sComputerName = oNetwork.Computername
  Set oContainer = GetObject("WinNT://" & sComputerName)
  oContainer.Filter = Array("user")

  bUserExists = False
  For Each oUser in oContainer
    If lcase(trim(oUser.Name)) = lcase(trim(sUserName)) Then
      bUserExists = True
      Exit For
    End If
  Next

  UserExists = bUserExists
End Function

Function ChangePassword(sUserName, sPassword)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com

  If UserExists(sUserName) Then
    Set oNetwork = CreateObject("WScript.Network")
    sComputerName = oNetwork.Computername
    Set oUser = GetObject("WinNT://" & sComputerName & "/" & sUserName & ", user")
    
    oUser.SetPassword sPassword
    
    On Error Resume Next

    oUser.SetInfo

    If Err.Number = 0 Then
      ChangePassword = True
    Else
      ChangePassword = False
    End If

    On Error Goto 0
  Else
    ChangePassword = False
  End If
End Function

Function CreateGroup(sGroupName, sDescription)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com
  If GroupExists(sGroupName) Then
    CreateGroup = False
    Exit Function
  End If

  Set oNetwork = CreateObject("WScript.Network")
  sComputerName = oNetwork.Computername
  Set oContainer = GetObject("WinNT://" & sComputerName)
  Set oGroup = oContainer.Create("group", sGroupName)

  oGroup.SetInfo

  Set oGroup = Nothing
  Set oContainer = Nothing

  Set oGroup = GetObject("WinNT://" & sComputerName & "/" & sGroupName & ",group")
  oGroup.Description = sDescription
  oGroup.SetInfo

  Set oGroup = Nothing
  Set oNetwork = Nothing
End Function

Function DeleteGroup(sGroupName)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com

  If Not GroupExists(sGroupName) Then
    DeleteGroup = False
    Exit Function
  End If

  On Error Resume Next

  Set oNetwork = CreateObject("WScript.Network")
  sComputerName = oNetwork.Computername
  Set oContainer = GetObject("WinNT://" & sComputerName)
  oContainer.Delete "group", sGroupName

  If Err.Number = 0 then
    If UserExists(sGroupName) Then
      DeleteGroup = False
    Else
      DeleteGroup = True
    End IF
  Else
    DeleteGroup = False
  End If

  On Error Goto 0

End Function

Function GroupExists(sGroupName)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com

  'Returns True or False based on if the local group
  'exists.

  Set oNetwork = CreateObject("WScript.Network")
  sComputerName = oNetwork.Computername
  Set oContainer = GetObject("WinNT://" & sComputerName)
  oContainer.Filter = Array("group")

  bGroupExists = False
  For Each oGroup in oContainer
    If lcase(trim(oGroup.Name)) = lcase(trim(sGroupName)) Then
      bGroupExists = True
      Exit For
    End If
  Next

  GroupExists = bGroupExists
End Function

Function AddUserToGroup(sUserName, sGroup)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com
  On Error Resume Next

  Set oNetwork = CreateObject("WScript.Network")
  sComputerName = oNetwork.Computername
   
  Set oGroup = GetObject("WinNT://" & sComputerName & "/" & sGroup & ",group")
  Set oUser = GetObject("WinNT://" & sComputerName & "/" & sUserName & ",user")

  If Not oGroup.IsMember(oUser.AdsPath) Then
    oGroup.Add(oUser.AdsPath)
  End If

  If Err.Number = 0 Then
    AddUserToGroup = True
  Else
    AddUserToGroup = False
  End If
  
  Set oNetwork = Nothing
  Set oGroup = Nothing
  Set oUser = Nothing

  On Error Goto 0
End Function

Function RemoveUserFromGroup(sUserName, sGroup)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com
  On Error Resume Next

  Set oNetwork = CreateObject("WScript.Network")
  sComputerName = oNetwork.Computername
  Set oGroup = GetObject("WinNT://" & sComputerName & "/" & sGroup & ",group")
  Set oUser = GetObject("WinNT://" & sComputerName & "/" & sUserName & ",user")

  If oGroup.IsMember(oUser.AdsPath) Then
    oGroup.Remove(oUser.AdsPath)
  End If
  
  If Err.Number = 0 Then
    RemoveUserFromGroup = True
  Else
    RemoveUserFromGroup = False
  End If
  
  Set oNetwork = Nothing
  Set oGroup = Nothing
  Set oUser = Nothing
  
  On Error Goto 0
End Function

Function RndPassword(vLength)
  'This function will generate a random strong password of variable
  'length.
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com
 
  For x=1 To vLength
    Randomize
    vChar = Int(89*Rnd) + 33
    If vChar = 34 Then 'this is quote character, replace it with a single quote
      vChar = 39
    End if

    RndPassword = RndPassword & Chr(vChar)
  Next

End Function

 

1 thought on “Local User and Group Management with VBScript and ADSI”

Leave a Comment