Talk:Integrate Moodle, LDAP and SIMS.net
From MoodleDocs
The following code has been copied from a page SIMS2AD.vbs before deleting it. Please delete if obsolete. --Helen Foster 14:40, 2 January 2011 (UTC)
SIMS2AD.vbs
'/////////////////////////////////////////////////////////////////////////////
'// //
'// NOTICE OF COPYRIGHT //
'// //
'// SIMS2AD - Script to create active directory accounts when students //
'// are enrolsed on SIMS.net //
'// //
'// Copyright (C) 2008 onwards Ian Tasker http://www.uctc.e-sussex.sch.uk //
'// //
'// This program is free software; you can redistribute it and/or modify //
'// it under the terms of the GNU General Public License as published by //
'// the Free Software Foundation; either version 2 of the License, or //
'// (at your option) any later version. //
'// //
'// This program is distributed in the hope that it will be useful, //
'// but WITHOUT ANY WARRANTY; without even the implied warranty of //
'// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
'// GNU General Public License for more details: //
'// //
'// http://www.gnu.org/copyleft/gpl.html //
'// //
'/////////////////////////////////////////////////////////////////////////////
Option Explicit
'+------------------------------------------------------------------------+
'| SIMS-AD Synchronisation Script Configuration |
'+------------------------------------------------------------------------+
'The script will automatically create an active directory account
'all students enrolled on SIMS.net
'The account will have all the information required to integrate Moodle
'and SIMS.net
'+------------------------------------------------------------------------+
'| Connection Setting for SIMS SQL Server |
'+------------------------------------------------------------------------+
const SIMS_USER = ""
const SIMS_PASS = ""
const SIMS_SERVER = "xx.xx.xx.xx,1427\[Instance Name]"
const SIMS_DB = "sims"
'+------------------------------------------------------------------------+
'| Email Settings |
'+------------------------------------------------------------------------+
'Email address to send the script report
Dim strReportEmailAddress
strReportEmailAddress = "user@domain.com"
const SMTP_SERVER = "xx.xx.xx.x"
'+------------------------------------------------------------------------+
'| Custom Settings |
'+------------------------------------------------------------------------+
'Add Emaill address to AD accounts
Const EmailService = TRUE
'Add Termail Services information to AD accounts
Const TerminalService = TRUE
'Create AD accounts - If False if will only report what accounts need to be created
Const USER_CREATION = FALSE
'Create Home Drives - Options
'WINDOWS - Create home drives on WINDOWS server
'SAMBA - Create home driver on a SAMBA server
'FALSE - Do not create a home drive
Const FOLDER_CREATION = "SAMBA"
'Server name where the user home drives will reside [ NO \\ needed ]
Dim strServerComputer
strServerComputer = "student"
'Local Path on WINDOWS SERVER ONLY
Dim strServerLocalFolder
strServerLocalFolder = "e:\users\"
'Update Registration Group of AD Accounts
const AD_REG_UPDATE = TRUE
'Update UPNs of AD Accounts
const AD_UPN_UPDATE = FALSE
'Base OU that holds all year group OU's
Dim strBaseOU
strBaseOU = "OU=UCTC"
'Prfeix of Inatke OU [space required at the end]
Dim strIntakeOUPrefix
strIntakeOUPrefix = "OU=Year "
'Name of the file to run as Longon Script
Dim strLogonScript
strLogonScript = "logon.bat"
'AD Profile Path
Dim strProfilePath
strProfilePath = "\\" & strServerComputer & "\profiles$\xp\"
'AD Terminal Services Profile Path
Dim strTerminalServicesProfilePath
strTerminalServicesProfilePath = "\\" & strServerComputer & "\profiles$\termserv"
'school domain name for email
Dim strEmailDomain
strEmailDomain = "zimbra.uctc.e-sussex.sch.uk"
'Sets AD Account Company Name to the School Name
Dim strSchool
strSchool = "UCTC"
'Set the drive letter for studnet home drives
Dim strHomeDrive
strHomeDrive = "S:"
'Array of groups that the user should be a member of
'these have to be in the USERS OU
Dim arrUserDomainGroups
arrUserDomainGroups = Array("Student-Filtered")
'Array of groups that should have access to the users home drive share
Dim arrShareGroups
arrShareGroups = Array()
'Array of Domain groups add the the NTFS permissions
Dim arrNTFSNetworkGroups
arrNTFSNetworkGroups = Array(Array("Teachers",NTFS_READ))
'Array of Local groups add the the NTFS permissions
Dim arrNTFSLocalGroups
arrNTFSLocalGroups = Array(Array("Backup Operators",NTFS_READ))
'Array of student with there originally caluclated username.
'student listed are taught in the year below the year they date of birth would dictate
Dim arrStudentsYearBehind
arrStudentsYearBehind = Array("")
'+------------------------------------------------------------------------+
'| DO NOT EDIT ANYTHING BELOW THIS POINT |
'+------------------------------------------------------------------------+
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
Const adBookMarkFirst = 1
Const ADS_PROPERTY_UPDATE = 2
Const ADS_SCOPE_SUBTREE = 2
Const ADS_UF_ACCOUNTDISABLE = 2
Const ADS_PROPERTY_APPEND = 3
Const STUDENT_FORNAME = 2
Const STUDENT_MIDNAME = 3
Const STUDENT_SURNAME = 1
Const STUDENT_DOB = 4
Const STUDENT_UPN = 5
Const STUDENT_REG = 6
Const STUDENT_USERNAME = 7
Const STUDENT_INTAKE_YEAR = 8
Const STUDENT_PREF_SURNAME = 9
Const STUDENT_PREF_FORENAME = 10
Const STUDENT_AD_FORNAME = 2
Const STUDENT_AD_MIDNAME = 3
Const STUDENT_AD_SURNAME = 4
Const STUDENT_AD_UPN = 1
Const STUDENT_AD_REG = 5
Const STUDENT_AD_USERNAME = 0
Const STUDENT_AD_UAC = 7
Const STUDENT_AD_DESCRIPTION = 6
Const ACCOUNT_ENABLED = 512
Const FILE_SHARE = 0
Const SHARE_FULL = 2032127
Const SHARE_CHANGE = 1245631
Const SHARE_READ = 1179817
Const NTFS_FULL = "f"
Const NTFS_CHANGE = "c"
Const NTFS_READ = "r"
'+------------------------------------------------------------------------+
'| Globals |
'+------------------------------------------------------------------------+
Dim SIMS_Connection
Dim objSIMSConnection 'SIMS database connection
Dim objSIMSRecordSet 'SIMS database connection
Dim objADConnection 'AD connection
Dim objADCommand 'AD command
Dim objADRecordSet 'AD RecordSet
Dim objAD2Connection 'AD connection
Dim objAD2Command 'AD command
Dim objAD2RecordSet 'AD RecordSet
Dim objADObject 'AD Object
Dim objADClass 'AD Class
Dim objADChild 'AD Class
Dim objADAttribute
Dim strCommandType 'The execution type
Dim strSQL 'SQL Query
Dim ArrStudents
Dim ArrADStudents
Dim count,count2,count3,count4,count5
Dim arrIntakeYear
Dim intoffset
Dim intyearnow
Dim intintakeyear
Dim intyearob
Dim flgFirstIntake
Dim intElementCount
Dim intCounter
Dim strQuery,strFilter,strOU,strTempUsr,objUser,objLeaf,objContainer,objDomain,objSysInfo,errReturn,objWMIService,objNewShare,strUNCFolder,objFSO
Dim objRoot,arrLocalGroupRights,arrNetworkGroupRights,arrShareRights,msg,msg1,msg2,msg3,msg4,msg5,objEmail,intPrimaryGroupToken
Dim Services
Dim SecDescClass
Dim SecDesc
Dim Trustee
Dim ACE
Dim Share
Dim InParam
dim v, colShares, objShare,flgMultiGroups,arrUserGroups,objGroup,intTemp,strADupdate
'+------------------------------------------------------------------------+
'| Create Objects |
'+------------------------------------------------------------------------+
Set objRoot = GetObject("LDAP://rootDSE")
Set objDomain = GetObject("LDAP://" & objRoot.Get("defaultNamingContext"))
Set objSIMSConnection = CreateObject("ADODB.Connection")
Set objSIMSRecordset = CreateObject("ADODB.Recordset")
Set objADConnection = CreateObject("ADODB.Connection")
Set objADCommand = CreateObject("ADODB.Command")
Set objSysInfo = CreateObject("ADSystemInfo")
'+------------------------------------------------------------------------+
'| Set SQL Query Strings |
'+------------------------------------------------------------------------+
strSQL = "SELECT * FROM dbo.vbs_adsync"
SIMS_Connection = "DRIVER={SQL Server};SERVER=" & SIMS_SERVER & ";UID=" & SIMS_USER & ";PWD=" & SIMS_PASS & ";" & "DATABASE=" & SIMS_DB &";"
strQuery = "<LDAP://"& strBaseOU &"," & objRoot.Get("defaultNamingContext") & ">;" & strFilter & "; Name,employeeID,givenName,initials,sn,department,description,userAccountControl;subtree"
'+------------------------------------------------------------------------+
'| Set Other AD Related Items |
'+------------------------------------------------------------------------+
objADConnection.Provider = "ADsDSOObject"
objADConnection.Open "Active Directory Provider"
Set objADCommand.ActiveConnection = objADConnection
objADCommand.Properties("Timeout") = 90 '60 is OK
objADCommand.Properties("Cache Results") = False
objADCommand.Properties("Page Size") = 1000
objADCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objADCommand.CommandText = strQuery
Set objADRecordSet = objADCommand.Execute
strFilter = "(&(objectCategory=user))"
'+------------------------------------------------------------------------+
'| Set Flags |
'+------------------------------------------------------------------------+
flgFirstIntake = True
'+------------------------------------------------------------------------+
'| Get Information from SIMS SQL Server |
'+------------------------------------------------------------------------+
objSIMSConnection.Open SIMS_Connection
objSIMSRecordset.CursorLocation = adUseClient
objSIMSRecordset.Open strSQL, objSIMSConnection, adOpenStatic, adLockOptimistic
ArrStudents = objSIMSRecordset.GetRows(, , Array("person_id","legal_surname","forename","midname", "dob","unique_pupil_no", "reg_group","roll_mode","year_group","surname","chosen_forename"))
objSIMSRecordset.Close
arrIntakeYear = array("AAA")
For count = 0 to ubound(ArrStudents,2)
count3 = 0
dim strmonth
strmonth = split(ArrStudents(STUDENT_DOB,count),"/")
if cint(strmonth(1)) >=9 then
intoffset = 1
else
intoffset = 0
end if
if cint(datepart("m",now())) < 9 then
intyearnow = cint(datepart("yyyy",now()))-1
else
intyearnow = cint(datepart("yyyy",now()))
end if
intyearob = cint(DatePart("yyyy",FormatDateTime(ArrStudents(STUDENT_DOB,count),2)))
intintakeyear = Right("00" & 19 - (intyearnow - (intyearob + intoffset)),2)
if intintakeyear < 0 then
intintakeyear = 100 + intintakeyear
end if
strTempUsr = intintakeyear & left(ArrStudents(STUDENT_FORNAME,count),1) & left(ArrStudents(STUDENT_MIDNAME,count),1) & replace(Replace(ArrStudents(STUDENT_SURNAME,count),"'",""),"-","")
for count4 =0 to ubound(arrStudentsYearBehind)
if strTempUsr = arrStudentsYearBehind(count4) then
intintakeyear = right("00" & intintakeyear + 1,2)
end if
next
if (intintakeyear <> "00" and intintakeyear <> "99" and intintakeyear <> "98") then
If intintakeyear = "07" then
ArrStudents(STUDENT_USERNAME,count) = intintakeyear & left(ArrStudents(STUDENT_FORNAME,count),1) & Replace(Replace(Replace(ArrStudents(STUDENT_SURNAME,count),"'",""),"-","")," ","")
else
ArrStudents(STUDENT_USERNAME,count) = intintakeyear & left(ArrStudents(STUDENT_FORNAME,count),1) & left(ArrStudents(STUDENT_MIDNAME,count),1) & Replace(Replace(Replace(ArrStudents(STUDENT_SURNAME,count),"'",""),"-","")," ","")
end if
If flgFirstIntake = True then
arrIntakeYear(count2) = intintakeyear
else
For count2 = 0 to UBound(arrIntakeYear)
If arrIntakeYear(count2) = intintakeyear then
count3 = count3 + 1
end if
next
if count3 = 0 then
intElementCount = CInt(UBound(arrIntakeYear))
ReDim Preserve arrIntakeYear(CInt(intElementCount + 1))
arrIntakeYear(UBound(arrIntakeYear)) = intintakeyear
end if
end if
flgFirstIntake = false
else
ArrStudents(STUDENT_USERNAME,count) = left(ArrStudents(STUDENT_FORNAME,count),1) & left(ArrStudents(STUDENT_MIDNAME,count),1) & replace(Replace(ArrStudents(STUDENT_SURNAME,count),"'",""),"-","")
end if
ArrStudents(STUDENT_INTAKE_YEAR,count) = intintakeyear
next
'+------------------------------------------------------------------------+
'| Get Information from Active Directory and Compare to SIMS.net |
'+------------------------------------------------------------------------+
ArrADStudents = objADRecordset.GetRows(, , Array("Name","employeeID","givenName","initials", "sn","department","description","userAccountControl"))
intCounter = 0
For count = 0 to ubound(ArrStudents,2)
for count2 = 0 to ubound(ArrADstudents,2)
if (ucase(ArrStudents(STUDENT_USERNAME,count)) = ucase(ArrADStudents(STUDENT_AD_USERNAME,count2))) and (ArrStudents(STUDENT_UPN,count) = ArrADStudents(STUDENT_AD_UPN,count2)) then
intCounter = intCounter + 1
exit for
else
if (ArrStudents(STUDENT_INTAKE_YEAR,count) = left(ArrADStudents(STUDENT_AD_USERNAME,count2),2)) or (ArrStudents(STUDENT_INTAKE_YEAR,count) = "00") or (ArrStudents(STUDENT_INTAKE_YEAR,count) = "99") or (ArrStudents(STUDENT_INTAKE_YEAR,count) = "98") then
if ucase(ArrStudents(STUDENT_FORNAME,count)) = ucase(ArrADStudents(STUDENT_AD_FORNAME,count2)) or (ucase(ArrStudents(STUDENT_FORNAME,count)) <> ucase(ArrStudents(STUDENT_PREF_FORENAME,count)) and (ucase(ArrStudents(STUDENT_PREF_FORENAME,count)) = ucase(ArrADStudents(STUDENT_AD_FORNAME,count2)))) then
if (ucase(ArrStudents(STUDENT_SURNAME,count)) = ucase(ArrADStudents(STUDENT_AD_SURNAME,count2))) or (ucase(ArrStudents(STUDENT_SURNAME,count)) <> ucase(ArrStudents(STUDENT_PREF_SURNAME,count)) and (ucase(ArrStudents(STUDENT_PREF_SURNAME,count)) = ucase(ArrADStudents(STUDENT_AD_SURNAME,count2)))) then
if (ucase(Left(ArrStudents(STUDENT_MIDNAME,count),1)) = ucase(left(ArrADStudents(STUDENT_AD_MIDNAME,count2),1))) or (isnull(Left(ArrStudents(STUDENT_MIDNAME,count) ,1)) or len(ucase(ArrStudents(STUDENT_MIDNAME,count))) = 0) or (left(ArrStudents(STUDENT_USERNAME,count),2) = "07") then
v = ArrADStudents(STUDENT_AD_DESCRIPTION,count2)
If Not IsNULL(v) Then
If instr(v(0), left(replace(ArrStudents(STUDENT_DOB,count),"/",""),4) & right(replace(ArrStudents(STUDENT_DOB,count),"/",""),2)) then
if ucase(ArrStudents(STUDENT_REG,count)) = ucase(ArrADStudents(STUDENT_AD_REG,count2)) then
if (ArrStudents(STUDENT_UPN,count) = ArrADStudents(STUDENT_AD_UPN,count2)) then
intCounter = intCounter + 1
For count3 = 0 to 7
ArrStudents(count3,count) =""
next
exit for
else
if AD_UPN_UPDATE = false then
strADupdate = "needs to be "
end if
intTemp = Len(ArrStudents(STUDENT_USERNAME,count))
if isnull(ArrADStudents(STUDENT_AD_UPN,count2)) then
ArrADStudents(STUDENT_AD_UPN,count2) = "<Blank>"
end if
call formatErrorMsg(ArrStudents(STUDENT_USERNAME,count),strADupdate & "changed from " & ArrADStudents(STUDENT_AD_UPN,count2) & " to " & ArrStudents(STUDENT_UPN,count),"UPN Update")
intCounter = intCounter + 1
'+------------------------------------------------------------------------+
'| Update UPN in Active Directory |
'+------------------------------------------------------------------------+
if AD_UPN_UPDATE = true then
Set objUser = GetObject ("LDAP://cn=" & ArrStudents(STUDENT_USERNAME,count) & ",OU=Year " & left(ArrStudents(STUDENT_USERNAME,count),2) & "," & strBaseOU & "," & objRoot.Get("defaultNamingContext"))
if isnull(ArrStudents(STUDENT_UPN,count)) then
Msgbox ArrStudents(STUDENT_USERNAME,count) & " - SIMS UPN " & ArrStudents(STUDENT_UPN,count) & " - AD UPN " & ArrADStudents(STUDENT_AD_UPN,count2)
else
objUser.PutEx ADS_PROPERTY_UPDATE, "employeeId", Array(ArrStudents(STUDENT_UPN,count))
objUser.SetInfo
end if
end if
exit for
end if
else
if (ArrStudents(STUDENT_UPN,count) = ArrADStudents(STUDENT_AD_UPN,count2)) then
if AD_REG_UPDATE = false then
strADupdate = "needs to be "
end if
intTemp = Len(ArrStudents(STUDENT_USERNAME,count))
if isnull(ArrADStudents(STUDENT_AD_REG,count2)) then
ArrADStudents(STUDENT_AD_REG,count2) = "<Blank>"
end if
call formatErrorMsg(ArrStudents(STUDENT_USERNAME,count),strADupdate & "moved from " & ArrADStudents(STUDENT_AD_REG,count2) & " to " & ArrStudents(STUDENT_REG,count),"Reg Group Update")
intCounter = intCounter + 1
'+------------------------------------------------------------------------+
'| Update Registration Group in Active Directory |
'+------------------------------------------------------------------------+
if AD_REG_UPDATE = true then
objADCommand.CommandText = "SELECT distinguishedName FROM 'LDAP://" & objRoot.Get("defaultNamingContext") & "' WHERE objectCategory='user' " & "AND employeeID='" & ArrStudents(STUDENT_UPN,count) &"'"
Set objADRecordSet = objADCommand.Execute
objADRecordSet.MoveFirst
Set objUser = GetObject("LDAP://"& objADRecordSet.Fields("distinguishedName").Value)
'Set objUser = GetObject ("LDAP://cn=" & ArrStudents(STUDENT_USERNAME,count) & ",OU=Year " & left(ArrADStudents(STUDENT_USERNAME,count),2) & "," & strBaseOU & "," & objRoot.Get("defaultNamingContext"))
objUser.PutEx ADS_PROPERTY_UPDATE, "department", Array(ArrStudents(STUDENT_REG,count))
objUser.SetInfo
end if
exit for
else
intCounter = intCounter + 1
exit for
end if
end if
else
'this section is only need to be uncomment if you have two users with the same name and date of birth
'if ArrStudents(STUDENT_USERNAME,count) <> "" and ArrStudents(STUDENT_USERNAME,count) <> "" and ArrStudents(STUDENT_USERNAME,count) <> "" and ArrStudents(STUDENT_USERNAME,count) <> "" then
' loggit ArrStudents(STUDENT_USERNAME,count) & " DOB is different, SIMS DOB " & ArrStudents(STUDENT_DOB,count) & " - AD REG " & v(0),"Reg Group Update"
'end if
end if
else
loggit ArrStudents(STUDENT_USERNAME,count) & " AD User Description is Blank","Reg Group Update"
intCounter = intCounter + 1
exit for
end if
end if
else
end if
else
end if
else
end if
end if
next
'+------------------------------------------------------------------------+
'| Create the user account if required |
'+------------------------------------------------------------------------+
if intCounter = 0 then
If USER_CREATION = TRUE then
'msgbox ArrStudents(STUDENT_USERNAME,count)
Set objContainer = GetObject("LDAP://" & strIntakeOUPrefix & ArrStudents(STUDENT_INTAKE_YEAR,count) & "," & strBaseOU & "," & objRoot.Get("defaultNamingContext"))
Set objLeaf = objContainer.Create("User", "cn=" & ArrStudents(STUDENT_USERNAME,count))
objLeaf.displayName = ArrStudents(STUDENT_PREF_FORENAME,count) & " " & ArrStudents(STUDENT_PREF_SURNAME,count)
objLeaf.givenName = ArrStudents(STUDENT_PREF_FORENAME,count)
If not isnull(ArrStudents(STUDENT_MIDNAME,count)) then
objLeaf.initials = ucase(Left(ArrStudents(STUDENT_MIDNAME,count),1))
end if
objLeaf.sn = ArrStudents(STUDENT_PREF_SURNAME,count)
objLeaf.Put "company", strSchool
if ArrStudents(STUDENT_REG,count) <> null then
objLeaf.Put "department", ArrStudents(STUDENT_REG,count)
end if
objLeaf.Put "description", array("Student " & ArrStudents(STUDENT_INTAKE_YEAR,count) & " / " & left(replace(ArrStudents(STUDENT_DOB,count),"/",""),4) & right(replace(ArrStudents(STUDENT_DOB,count),"/",""),2))
if ArrStudents(STUDENT_UPN,count) <> null then
objLeaf.Put "employeeId", ArrStudents(STUDENT_UPN,count)
end if
objLeaf.Put "employeeType", "STUDENT"
if FOLDER_CREATION = "SAMBA" then
objLeaf.Put "homeDirectory","\\" & strServerComputer & "\" & ArrStudents(STUDENT_USERNAME,count)
elseif FOLDER_CREATION = "WINDOWS" then
objLeaf.Put "homeDirectory","\\" & strServerComputer & "\" & ArrStudents(STUDENT_USERNAME,count) & "$"
end if
objLeaf.sAMAccountName = ArrStudents(STUDENT_USERNAME,count)
objLeaf.Put "profilePath", strProfilePath & ArrStudents(STUDENT_INTAKE_YEAR,count)
objLeaf.Put "scriptPath", strLogonScript
objLeaf.Put "userPrincipalName" , ArrStudents(STUDENT_USERNAME,count) & "@" & objSysInfo.DomainDNSName
If EmailService = True then
objLeaf.Put "mailNickname", ArrStudents(STUDENT_USERNAME,count)
objLeaf.Put "mail", ArrStudents(STUDENT_USERNAME,count) & "@" & strEmailDomain
objLeaf.Put "proxyAddresses", "SMTP:" & ArrStudents(STUDENT_USERNAME,count) & "@" & strEmailDomain
objLeaf.put "targetAddress","SMTP:" & ArrStudents(STUDENT_USERNAME,count) & "@" & strEmailDomain
End if
If TerminalService = True then
objLeaf.TerminalServicesProfilePath = strTerminalServicesProfilePath
end if
objLeaf.SetInfo
objLeaf.homeDrive = strHomeDrive
objLeaf.userAccountControl = ACCOUNT_ENABLED
objLeaf.pwdLastSet = 0
objLeaf.SetPassword left(replace(ArrStudents(STUDENT_DOB,count),"/",""),4) & right(replace(ArrStudents(STUDENT_DOB,count),"/",""),2)
objLeaf.SetInfo
call formatErrorMsg(ArrStudents(STUDENT_USERNAME,count)," - " & ArrStudents(STUDENT_PREF_FORENAME,count) & " " & ArrStudents(STUDENT_PREF_SURNAME,count) & " - " & left(replace(ArrStudents(STUDENT_DOB,count),"/",""),4) & right(replace(ArrStudents(STUDENT_DOB,count),"/",""),2) & " - " & ArrStudents(STUDENT_REG,count) & " - AD Account Created","Account Creation")
Set objUser = GetObject _
("LDAP://CN=" & ArrStudents(STUDENT_USERNAME,count) & "," & strIntakeOUPrefix & ArrStudents(STUDENT_INTAKE_YEAR,count) & "," & strBaseOU & "," & objRoot.Get("defaultNamingContext"))
Set objGroup = GetObject _
("LDAP://CN="& ArrStudents(STUDENT_INTAKE_YEAR,count) & "," & strIntakeOUPrefix & ArrStudents(STUDENT_INTAKE_YEAR,count) & "," & strBaseOU & "," & objRoot.Get("defaultNamingContext"))
objGroup.GetInfoEx Array("primaryGroupToken"), 0
intPrimaryGroupToken = objGroup.Get("primaryGroupToken")
objGroup.PutEx ADS_PROPERTY_APPEND, _
"member", Array("CN=" & ArrStudents(STUDENT_USERNAME,count) & "," & strIntakeOUPrefix & ArrStudents(STUDENT_INTAKE_YEAR,count) & "," & strBaseOU & "," & objRoot.Get("defaultNamingContext"))
objGroup.SetInfo
objUser.Put "primaryGroupID", intPrimaryGroupToken
objUser.SetInfo
call formatErrorMsg(ArrStudents(STUDENT_USERNAME,count),"Added to Group " & ArrStudents(STUDENT_INTAKE_YEAR,count) ,"Account Creation")
for each arrUserGroups in arrUserDomainGroups
Set objGroup = GetObject("LDAP://CN=" & arrUserGroups &",CN=Users," & objRoot.Get("defaultNamingContext"))
objGroup.add(objLeaf.ADsPath)
call formatErrorMsg(ArrStudents(STUDENT_USERNAME,count),"Added to Group " & arrUserGroups,"Account Creation")
next
'+------------------------------------------------------------------------+
'| Create the user home drive if required |
'+------------------------------------------------------------------------+
If FOLDER_CREATION = "WINDOWS" then
strUNCFolder = "\\" & strServerComputer & "\" & Replace(strServerLocalFolder ,":","$") & ArrStudents(STUDENT_INTAKE_YEAR,count) & "\" & ArrStudents(STUDENT_USERNAME,count)
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strUNCFolder) Then
call formatErrorMsg(ArrStudents(STUDENT_USERNAME,count),arrUserGroups & "Home Directory " & strUNCFolder & " Already Exists","Account Creation")
Else
objFSO.CreateFolder strUNCFolder
End If
If ubound(arrShareGroups) <0 then
Set Services = GetObject("WINMGMTS:{impersonationLevel=impersonate,(Security)}!\\" & strServerComputer & "\ROOT\CIMV2")
Set SecDescClass = Services.Get("Win32_SecurityDescriptor")
Set SecDesc = SecDescClass.SpawnInstance_()
Set Trustee = Services.Get("Win32_Trustee").SpawnInstance_
Trustee.Domain = Null
Trustee.Name = "EVERYONE"
Trustee.Properties_.Item("SID") = Array(1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0)
Set ACE = Services.Get("Win32_Ace").SpawnInstance_
ACE.Properties_.Item("AccessMask") = SHARE_FULL
ACE.Properties_.Item("AceFlags") = 3
ACE.Properties_.Item("AceType") = 0
ACE.Properties_.Item("Trustee") = Trustee
SecDesc.Properties_.Item("DACL") = Array(ACE)
Set Share = Services.Get("Win32_Share")
Set InParam = Share.Methods_("Create").InParameters.SpawnInstance_()
InParam.Properties_.Item("Access") = SecDesc
InParam.Properties_.Item("Description") = ""
InParam.Properties_.Item("Name") = ArrStudents(STUDENT_USERNAME,count) & "$"
InParam.Properties_.Item("Path") = strServerLocalFolder & ArrStudents(STUDENT_INTAKE_YEAR,count) & "\" & ArrStudents(STUDENT_USERNAME,count)
InParam.Properties_.Item("Type") = 0
Share.ExecMethod_ "Create", InParam
else
flgMultiGroups = FALSE
for each arrShareRights in arrShareGroups
if flgMultiGroups = FALSE then
Set Services = GetObject("WINMGMTS:{impersonationLevel=impersonate,(Security)}!\\" & strServerComputer & "\ROOT\CIMV2")
Set SecDescClass = Services.Get("Win32_SecurityDescriptor")
Set SecDesc = SecDescClass.SpawnInstance_()
Set Trustee = SetGroupTrustee(objSysInfo.DomainShortName, arrShareGroups(0)) 'Use SetGroupTrustee for groups and SetAccountTrustee for users
Set ACE = Services.Get("Win32_Ace").SpawnInstance_
ACE.Properties_.Item("AccessMask") = SHARE_FULL
ACE.Properties_.Item("AceFlags") = 3
ACE.Properties_.Item("AceType") = 0
ACE.Properties_.Item("Trustee") = Trustee
SecDesc.Properties_.Item("DACL") = Array(ACE)
Set Share = Services.Get("Win32_Share")
Set InParam = Share.Methods_("Create").InParameters.SpawnInstance_()
InParam.Properties_.Item("Access") = SecDesc
InParam.Properties_.Item("Description") = ""
InParam.Properties_.Item("Name") = ArrStudents(STUDENT_USERNAME,count) & "$"
InParam.Properties_.Item("Path") = strServerLocalFolder & ArrStudents(STUDENT_INTAKE_YEAR,count) & "\" & ArrStudents(STUDENT_USERNAME,count)
InParam.Properties_.Item("Type") = 0
Share.ExecMethod_ "Create", InParam
flgMultiGroups = TRUE
else
call ModifySharePerm(strServerComputer, ArrStudents(STUDENT_USERNAME,count) & "$", arrShareGroups(count5), objSysInfo.DomainShortName, "r", "g", "a")
end if
next
end if
call ModifyFilePerm(strServerComputer, strServerLocalFolder & ArrStudents(STUDENT_INTAKE_YEAR,count) & "\" & ArrStudents(STUDENT_USERNAME,count) , ArrStudents(STUDENT_USERNAME,count), objSysInfo.DomainShortName, "c", "u", "a")
for each arrNetworkGroupRights in arrNTFSNetworkGroups
call ModifyFilePerm(strServerComputer, strServerLocalFolder & ArrStudents(STUDENT_INTAKE_YEAR,count) & "\" & ArrStudents(STUDENT_USERNAME,count) , arrNetworkGroupRights(0), objSysInfo.DomainShortName, arrNetworkGroupRights(1), "g", "a")
next
for each arrLocalGroupRights in arrNTFSLocalGroups
call ModifyFilePerm(strServerComputer, strServerLocalFolder & ArrStudents(STUDENT_INTAKE_YEAR,count) & "\" & ArrStudents(STUDENT_USERNAME,count) , arrLocalGroupRights(0), strServerComputer, arrLocalGroupRights(1), "g", "a")
next
end if
loggit " ","Account Creation"
else
call formatErrorMsg(ArrStudents(STUDENT_USERNAME,count),"needs to be created for " & ArrStudents(STUDENT_FORNAME,count) & " " & ArrStudents(STUDENT_MIDNAME,count) & " " & ArrStudents(STUDENT_SURNAME,count) & " " & ArrStudents(STUDENT_REG,count),"Account Creation")
end if
else
intCounter = 0
end if
Next
'+------------------------------------------------------------------------+
'| Email Report |
'+------------------------------------------------------------------------+
loggit "","Print"
'+------------------------------------------------------------------------+
'| End of Script |
'+------------------------------------------------------------------------+
'+------------------------------------------------------------------------+
'| Function to Email a report of what the script has done |
'+------------------------------------------------------------------------+
sub loggit (msg, section)
'dim stream
if section="UPN Update" then
msg2 = msg2 & msg & vbcrlf
elseif section="Reg Group Update" then
msg1 = msg1 & msg & vbcrlf
elseif section="Account Creation" then
msg3 = msg3 & msg & vbcrlf
elseif section="Print" then
Set objEmail = CreateObject("CDO.Message")
objEmail.From = strReportEmailAddress
objEmail.To = strReportEmailAddress
objEmail.Subject = "SIMS2AD User Synchronisation Report"
dim mail
mail = "************* Registration Group Updated *************" & vbcrlf
mail = mail & "" & vbcrlf
mail = mail & msg1 & vbcrlf
mail = mail & "******************************************************" & vbcrlf
mail = mail & "" & vbcrlf
mail = mail & "******************** UPNs Updated ********************" & vbcrlf
mail = mail & "" & vbcrlf
if isempty(msg2) then
mail = mail & "<None>" & vbcrlf
mail = mail & "" & vbcrlf
else
mail = mail & msg2 & vbcrlf
end if
mail = mail & "******************************************************" & vbcrlf
mail = mail & "" & vbcrlf
mail = mail & "****************** Accounts Created ******************" & vbcrlf
mail = mail & "" & vbcrlf
mail = mail & msg3 & vbcrlf
mail = mail & "******************************************************" & vbcrlf
objEmail.Textbody = mail
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
SMTP_SERVER
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
end if
end sub
'+------------------------------------------------------------------------+
'| Function to Create Folders and Assign Permissions |
'+------------------------------------------------------------------------+
Function SetAccountTrustee(strDomain, strName)
Dim objTrustee
Dim account
Dim accountSID
set objTrustee = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Trustee").Spawninstance_
set account = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Account.Name='" & strName & "',Domain='" & strDomain &"'")
set accountSID = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_SID.SID='" & account.SID &"'")
objTrustee.Domain = strDomain
objTrustee.Name = strName
objTrustee.Properties_.item("SID") = accountSID.BinaryRepresentation
set accountSID = nothing
set account = nothing
set SetAccountTrustee = objTrustee
End Function
Function SetGroupTrustee(strDomain, strName)
Dim objTrustee
Dim account
Dim accountSID
set objTrustee = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Trustee").Spawninstance_
set account = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Group.Name='" & strName & "',Domain='" & strDomain &"'")
set accountSID = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_SID.SID='" & account.SID &"'")
objTrustee.Domain = strDomain
objTrustee.Name = strName
objTrustee.Properties_.item("SID") = accountSID.BinaryRepresentation
set accountSID = nothing
set account = nothing
set SetGroupTrustee = objTrustee
End Function
Function ModifySharePerm(strComputer, strShareName, strUsername, strDomain, strAccessLvl, strUtype, strMode)
Dim dacl, Services, SecDescClass, SecDesc, intRetVal
Dim objShareFolderSecuritySettings, wmiSecurityDescriptor, objSD
Dim colShares, objShare, errReturn
'Set Services = GetObject("winmgmts:{impersonationLevel=impersonate,(Security)}!\\" & strComputer & "\ROOT\CIMV2")
Set Services = GetObject("winmgmts:{impersonationLevel=impersonate,(Security)}!\\" & strComputer & "/root/cimv2")
Set SecDescClass = Services.Get("Win32_SecurityDescriptor")
Set SecDesc = SecDescClass.SpawnInstance_
'Get security descriptor for share.
Set objShareFolderSecuritySettings = GetObject("winmgmts:{impersonationLevel=impersonate,(Security)}!\\" & strComputer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name=""" & strShareName & """")
'you can have problems here if you have no descriptor ie only everyone listed.
intRetVal = objShareFolderSecuritySettings.GetSecurityDescriptor(objSD)
dacl = objSD.DACL
If strMode = "a" Then
AddUserAce dacl, strUsername, strDomain, strUtype, strComputer, strAccessLvl, Services
SecDesc.Properties_.Item("DACL") = dacl
'loggit "adding " & strusername & " to the dacl for " & strSharename & "."
ElseIf strMode = "d" Then 'Must mean delete access.
SecDesc.Properties_.Item("DACL") = DeleteUserAce(dacl, strUsername, strDomain, strUtype, strComputer, Services)
Else 'Must mean modify access 8), note this one only returns string, not Ace Array.
dim a
call ModifyUserAce(dacl, strUsername, strAccessLvl)
SecDesc.Properties_.Item("DACL") = dacl
End if
Set colShares = Services.ExecQuery("Select * from Win32_Share Where name = '" & strSharename & "'")
For Each objShare in colShares
errReturn = objShare.SetShareInfo(objShare.MaximumAllowed, objShare.Description, SecDesc)
ModifySharePerm = GetResultMessageShare(errReturn, strSharename, strUsername)
Next
Set Services = nothing
Set SecDescClass = nothing
Set SecDesc = nothing
Set objShareFolderSecuritySettings = nothing
Set colShares = nothing
End Function
Function ModifyFilePerm(strComputer, strFilePath, strUsername, strDomain, strAccessLvl, strUtype, strMode)
Dim dacl, Services, SecDescClass, SecDesc, intRetVal
Dim wmiFileSecSetting, wmiFileSetting, wmiSecurityDescriptor
Set Services = GetObject("winmgmts:{impersonationLevel=impersonate,(Security)}!\\" & strComputer & "\ROOT\CIMV2")
Set SecDescClass = Services.Get("Win32_SecurityDescriptor")
Set SecDesc = SecDescClass.SpawnInstance_
strFilePath = replace(strFilePath,"\","\\")
Set wmiFileSetting = GetObject("Winmgmts:{impersonationlevel=impersonate,(Security)}!//" & strComputer & "/root/cimv2:Win32_Directory='" & strFilePath & "'")
Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate,(Security)}!\\" & strComputer & _
"\ROOT\CIMV2:Win32_LogicalFileSecuritySetting.path='" & strFilePath & "'")
'you can have problems here if you have no descriptor ie only everyone listed.
intRetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
' Obtain existing security descriptor for folder
If Err <> 0 Then
loggit "GetSecurityDescriptor failed" & VBCRLF & Err.Number & VBCRLF & Err.Description
WScript.Quit
End If
' Retrieve the content of Win32_SecurityDescriptor DACL property.
DACL = wmiSecurityDescriptor.dacl
If strMode = "a" Then 'add user
AddUserAce dacl, strUsername, strDomain, strUtype, strComputer, strAccessLvl, Services
SecDesc.Properties_.Item("DACL") = dacl
If wmiFileSetting.changesecuritypermissions(SecDesc, 4) = 0 then
call formatErrorMsg(ArrStudents(STUDENT_USERNAME,count),"Added " & strusername & " Security Rigths on Home Directory - " & replace(strFilePath,"\\","\") ,"Account Creation")
else
call formatErrorMsg(ArrStudents(STUDENT_USERNAME,count),"Failed Adding " & strusername & " Security Rigths to Home Directory - " & replace(strFilePath,"\\","\"),"Account Creation")
end if
'loggit "adding " & strusername & " to the dacl for " & replace(strFilePath,"\\","\") & "." & vbcrlf & _
' "Result of change: " & wmiFileSetting.changesecuritypermissions(SecDesc, 4),"Account Creation"
ElseIf strMode = "d" Then 'Must mean delete access.
SecDesc.Properties_.Item("DACL") = DeleteUserAce(dacl, strUsername, strDomain, strUtype, strComputer, Services)
loggit "deleting " & strusername & " to the dacl for " & replace(strFilePath,"\\","\") & "." & vbcrlf & _
"Result of change: " & wmiFileSetting.changesecuritypermissions(SecDesc, 4),"Account Creation"
Else 'Must mean modify access 8), note this one only returns string, not Ace Array.
call ModifyUserAce(wmiSecurityDescriptor.dacl, strUsername, strAccessLvl)
'only need this to modify an entry
intRetVal = wmiFileSecSetting.SetSecurityDescriptor(wmiSecurityDescriptor)
call GetResultMessageFile(intretval, replace(strFilePath,"\\","\"), strUsername)
End If
Set Services = nothing
Set SecDescClass = nothing
Set SecDesc = Nothing
Set wmiFileSecSetting = nothing
Set wmiFileSetting = nothing
End Function
Function GetObjTrustee(strUsername, strDomain, strUtype, strComputer)
'Get and user/group object to copy user/group sid to new trustee instance to be returned
Dim objTrustee, account, accountSID
Set objTrustee = getObject("Winmgmts:{impersonationlevel=impersonate}!//" & strComputer & "/root/cimv2:Win32_Trustee").Spawninstance_
'For some reason you can't seem to be able to connect remotely to get account.
If strUtype = "g" Then
'Set account = getObject("Winmgmts:{impersonationlevel=impersonate}!//" & strComputer & "/root/cimv2:Win32_Group.Name='" & strUsername & "',Domain='" & strDomain &"'")
Set account = getObject("Winmgmts:{impersonationlevel=impersonate}!//" & strComputer & "/root/cimv2:Win32_Group.Name='" & strUsername & "',Domain='" & strDomain &"'")
Else
'Set account = getObject("Winmgmts:{impersonationlevel=impersonate}!//" & strComputer & "/root/cimv2:Win32_Account.Name='" & strUsername & "',Domain='" & strDomain &"'")
Set account = getObject("Winmgmts:{impersonationlevel=impersonate}!//" & strComputer & "/root/cimv2:Win32_Account.Name='" & strUsername & "',Domain='" & strDomain &"'")
End If
Set accountSID = getObject("Winmgmts:{impersonationlevel=impersonate}!//" & strComputer & "/root/cimv2:Win32_SID.SID='" & account.SID &"'")
objTrustee.Domain = strDomain
objTrustee.Name = strUsername
objTrustee.Properties_.item("SID") = accountSID.BinaryRepresentation
Set GetObjTrustee = objTrustee
Set accountSID = nothing
Set account = Nothing
Set objTrustee = nothing
End Function
Function AddUserAce( byref dacl, strUsername, strDomain, strUtype, strComputer, strAccessLvl, byref Services )
'Copy dacl to new ACE array then add specified user/group to ACE array and return it.
Dim intArrAceMax, arrACE, objACE
intArrAceMax = UBound(dacl) + 1
ReDim preserve dacl(intArrAceMax)
Set dacl(intArrAceMax) = Services.Get("Win32_Ace").SpawnInstance_
If strAccessLvl = "r" Then
dacl(intArrAceMax).Properties_.Item("AccessMask") = 1179817
ElseIf strAccessLvl = "w" Then
dacl(intArrAceMax).Properties_.Item("AccessMask") = 1245631
Else 'full access
dacl(intArrAceMax).Properties_.Item("AccessMask") = 2032127
End If
dacl(intArrAceMax).Properties_.Item("AceFlags") = 3
dacl(intArrAceMax).Properties_.Item("AceType") = 0
dacl(intArrAceMax).Properties_.Item("Trustee") = GetObjTrustee(strUsername, strDomain, strUtype, strComputer)
Set objACE = Nothing
End Function
Function DeleteUserAce( byref dacl, strUsername, strDomain, strUtype, strComputer, byref Services )
'Copy dacl to new ACE array Leaving out the one not.
Dim intArrAceMax, arrACE, i, objACE
intArrAceMax = UBound(dacl)
ReDim arrACE(intArrAceMax)
i = 0
For Each objACE in dacl
If UCase(objace.trustee.name) <> UCase(strUsername) Then
Set arrACE(i) = services.get("Win32_Ace").SpawnInstance_
arrACE(i).Properties_.Item("AccessMask") = objace.accessmask
arrACE(i).Properties_.Item("AceFlags") = objace.aceflags
arrACE(i).Properties_.Item("AceType") = objace.acetype
arrACE(i).Properties_.Item("Trustee") = objace.trustee
i = i + 1
End if
Next
If intArrAceMax > i - 1 Then
loggit "User/Group " & strUsername & " removed.","Account Creation"
ReDim preserve arrACE(intArrAceMax-1)
Else
loggit "User/Group " & strUsername & " not found.","Account Creation"
End If
DeleteUserAce = arrACE
For i = 0 to intArrAceMax - 1
Set arrACE(i) = nothing
Next
Set objACE = nothing
End Function
Function ModifyUserAce(byref dacl, strUsername, strAccessLvl)
'Modify dacl ACE entry with new accessmask.
Dim strMsg, objACE
strMsg = "User/Group: " & strUsername & " not found in dacl"
For Each objACE in dacl
If UCase(objace.trustee.name) = UCase(strUsername) Then
If strAccessLvl = "r" Then
objace.Properties_.Item("AccessMask") = 1179817
ElseIf strAccessLvl = "w" Then
objace.Properties_.Item("AccessMask") = 1245631
Else 'full access: didn't work in w2k - 131072 works in w2k - 2032127
objace.Properties_.Item("AccessMask") = 2032127
End If
strMsg = "User: " & strUsername & " found and modified to have " & strAccessLvl
Exit For
End If
Next
Set objACE = nothing
ModifyUserAce = strMsg
End Function
Function GetResultMessageShare(errReturn, strSharename, strUsername)
If errReturn = 0 Then
GetResultMessageShare = "Share permissions for " & strSharename & " successfully updated!"
Else
Select Case errReturn
case 2
errDesc = "Access denied."
Case 8
errDesc = "U known failure."
case 9
errDesc = "Invalid name."
Case 10
errDesc = "Invalid level."
Case 21
errDesc = "Invalid parameter."
Case 22
errDesc = "Duplicate share."
Case 23
errDesc = "Redirected path."
Case 24
errDesc = "Directory does not exist."
Case 25
errDesc = "Net name not found."
End Select
GetResultMessageShare = "Failed to update share permissions for " & strSharename & ". Error number: " & errReturn & ". " & errDesc
End If
End Function
Function GetResultMessageFile(errReturn, strSharename, strUsername)
If errReturn = 0 Then
GetResultMessageFile = "File permissions for " & strSharename & " successfully updated!"
Else
Select Case errReturn
case 2
errDesc = "Access denied."
Case 8
errDesc = "Unknown failure."
case 9
errDesc = "Privledge Missing."
Case 10
errDesc = "Invalid level."
Case 21
errDesc = "Invalid parameter."
Case 23
errDesc = "Redirected path."
Case 24
errDesc = "Directory does not exist."
Case 25
errDesc = "Net name not found."
End Select
GetResultMessageFile = "Failed to update File permissions for " & strSharename & ". Error number: " & errReturn & ". " & errDesc
End If
End Function
Function dbDate(dt)
dbDate = right("0" & day(dt),2) & "/" & right("0" & month(dt), 2) & "/" & year(dt)
End Function
function formatErrorMsg(username, message,section)
intTemp = Len(username)
'if intTemp < 8 then
' loggit trim(username) & vbtab & vbtab & vbtab & vbtab & message,section
'else
if intTemp < 12 then
loggit trim(username) & vbtab & vbtab & vbtab & message,section
elseif intTemp <= 15 then
loggit trim(username) & vbtab & vbtab & message,section
else
loggit trim(username) & vbtab & message,section
end if
end function
