%
Option Explicit
Dim pubcookie_user
Dim oRootDSE
Dim mydomain
Dim user_ou
Dim group_dn
Dim user_dn
mydomain = "DC=cac,DC=washington,DC=edu"
user_ou = "OU=Users,OU=Client Services,OU=IS," & mydomain
group_dn = "LDAP://CN=Testing Group," & user_ou
' Speed up subsequent LDAP bindings
Set oRootDSE = GetObject("LDAP://RootDSE")
' Grab username from Pubcookie
pubcookie_user = Request.ServerVariables("HTTP_PUBCOOKIE_USER")
' Uncomment for testing
' pubcookie_user = "testuser"
user_dn = "LDAP://CN=" & pubcookie_user & "," & user_ou
if pubcookie_user <> "" then
AddUser pubcookie_user,"Automatically generated account"
AddUsertoGroup user_dn, group_dn
UserFlags user_dn,False,True,False,False,True
' DN of account,Password can expire,User can change password,Account is disabled,
' Account is locked,Account requires a password
UserConfig user_dn,"","","","","01/03/2003"
' DN of account,User profile location,Login script location, User's home directory
' User's home drive, Date to expire accout - MM/DD/YYYY
Altsecid user_dn,"u.washington.edu"
Welcome_User
else
Response.Write "Error: Pubcookie user not set. This page should be protected by Pubcookie."
end if
Set oRootDSE = Nothing
' ************* end of main script *************
Const ADS_UF_SCRIPT = &H1
Const ADS_UF_ACCOUNTDISABLE = &H2
Const ADS_UF_HOMEDIR_REQUIRED = &H3
Const ADS_UF_LOCKOUT = &H10
Const ADS_UF_PASSWD_NOTREQD = &H20
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = &H80
Const ADS_UF_TEMP_DUPLICATE_ACCOUNT = &H100
Const ADS_UF_NORMAL_ACCOUNT = &H200
Const ADS_UF_INTERDOMAIN_TRUST_ACCOUNT = &H800
Const ADS_UF_WORKSTATION_TRUST_ACCOUNT = &H1000
Const ADS_UF_SERVER_TRUST_ACCOUNT = &H2000
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const ADS_UF_MNS_LOGON_ACCOUNT = &H20000
Const ADS_UF_SMARTCARD_REQUIRED = &H40000
Const ADS_UF_TRUSTED_FOR_DELEGATION = &H80000
Const ADS_UF_NOT_DELEGATED = &H100000
Sub Altsecid(strUser,realm)
Dim User
' Bind to the user object via LDAP
Set User = GetObject(strUser)
' Set the altSecurityIdentities Kerberos property
User.Put "altSecurityIdentities", "Kerberos:" & pubcookie_user & "@" & realm
User.SetInfo
Set User = Nothing
End Sub
Sub Welcome_User
Response.Write "Welcome, " & pubcookie_user & "."
End Sub
Sub AddUser(strUser,strDesc)
Dim o
Dim User
Dim strPassword
On Error Resume Next
' Create user account
Set o = GetObject("LDAP://" & user_ou )
Set User = o.Create("User", "CN=" & strUser)
User.Put "SAMAccountName", strUser
User.Description = strDesc
User.setinfo
If Err AND Err <> -2147019886 Then ' It's OK if the account already exists.
Response.Write "Unexpected COM error: " & Err.Number & "
"
End If
Err = 0
call User.SetPassword(NewPassword(28))
If Err Then
Response.Write "Unexpected COM error setting password: " & Err.Number & " Your new account may not be secure, please contact your departmental or lab computing support.
"
End If
Set User = Nothing
Set o = Nothing
End sub
Sub UserFlags(strUser,strPassexpires,strNochange,strDisable,strLocked,strPassrequired)
Dim User
Dim Flags,NewFlags
Set User = Getobject(strUser)
Flags = User.Get("UserAccountControl")
'Response.Write Flags & "
"
if strPassexpires = "False" then
Flags = Flags Or ADS_UF_DONT_EXPIRE_PASSWD
else
Flags = Flags And Not ADS_UF_DONT_EXPIRE_PASSWD
end if
if strNochange = "True" then
Flags = Flags Or ADS_UF_PASSWD_CANT_CHANGE
else
Flags = Flags And Not ADS_UF_PASSWD_CANT_CHANGE
end if
' See constants at start of script for other options.
User.Put "UserAccountControl", Flags
' Make sure to put other managment functions afer flags are set or the above
' call could override them.
if strDisable = "True" then
User.AccountDisabled = True
else
User.AccountDisabled = False
end if
if strLocked = "True" then
User.IsAccountLocked = True
else
User.IsAccountLocked = False
end if
if strPassrequired = "True" then
User.PasswordRequired = True
else
User.PasswordRequired = False
end if
User.SetInfo
Set User = nothing
End sub
Sub UserConfig(strUser,strProfile,strScript,strHomedir,strHomedirdrive,strAccountexpire)
Dim User,Flags
Set User = GetObject(strUser)
if strProfile <> "" Then
User.Profile = strProfile
End if
if strScript <> "" Then
User.LoginScript = strScript
End if
if strHomedir <> "" Then
User.Homedirectory = strHomedir
End if
if strHomedirdrive <> "" Then
User.Put("HomeDirDrive"),strHomedirdrive
End if
if strAccountexpire <> "" Then
User.AccountExpirationDate = strAccountexpire
'mm/dd/yyyy
End if
User.SetInfo
Set User = nothing
End sub
Sub AddUsertoGroup(strUser,strGroup)
On Error Resume Next
Dim Group
' Set group membership
Set Group = GetObject(strGroup)
Group.Add(strUser)
If Err AND Err <> -2147019886 Then ' Already a member error is OK
Response.Write "Unexpected COM error: " & Err.Number & "
"
End If
Set Group = nothing
End sub
Function NewPassword (length)
Dim i
Randomize
Do Until i = length
i = i + 1
NewPassword = NewPassword & Chr(Int((122 - 34) * Rnd + 33))
Loop
End Function
%>