'ProSolution to AD connector
'Written by Ashley Allen 2007
'version 0.1.1 Aug 22nd 11:35

'Turn off halting on errors - we know what it'll error on (see documentation)
On Error Resume Next
'Define initial variables and defaults
'Need to set up a System DSN on the server this is running on called rsAccounts
strUserName = "sa" 'SQL account
strPassword = "P4$$w0rd" 'Password for above
strParentDN = "OU=MKC Student Accounts,DC=mkcollege,DC=ac,DC=uk" 'Base OU for all student accounts - DONT CHANGE THIS!!!!
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
Dim strUserID 'Declare strUserID as a variable outside of loops
'Open connection to the SQL Box that contains the ProSolution Data Export
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")
objConnection.Open "DSN=rsAccounts;", strUserName, strPassword
objRecordset.CursorLocation = adUseClient
objRecordset.Open "SELECT * FROM users" , objConnection, adOpenStatic, adLockOptimistic 'Select everything from the database table
Do Until objRecordset.EOF 'Loop through records recursively

'set some variables
'strCopyPath is the campus root for user accounts
'strHomeDir is the UNC path to the root of the home$ share at each campus
'strAccessGroup gives the default S drive group
'strLoginScript defines the campus login script

'checks whether student is BL or KF, if not, defaults to CW

Dim strCopyPath, strHomeDir
strCampus = objRecordset("Campus")
if strCampus = "Bletchley Campus" then
	strCopyPath = "ou=0708,ou=BL,ou=MKC Student Accounts,dc=mkcollege,dc=ac,dc=uk"
	strHomeDir = "\\10.10.1.132\home$\0708\"
	strAccessGroup = "BL Shared,ou=Groups,dc=mkcollege,dc=ac,dc=uk"
	strLoginScript = "BLStudlog.bat"
elseif strCampus = "Kiln Farm" then
	strCopyPath = "ou=0708,ou=KF,ou=MKC Student Accounts,dc=mkcollege,dc=ac,dc=uk"
	strHomeDir = "\\10.4.1.150\home$\0708\"
	strAccessGroup = "KF Shared,ou=Groups,dc=mkcollege,dc=ac,dc=uk"
	strLoginScript = "KFStudlog.bat"
else 
	strCopyPath = "ou=0708,ou=CW,ou=MKC Student Accounts,dc=mkcollege,dc=ac,dc=uk"
	strHomeDir = "\\10.4.1.132\home$\0708\"
	strAccessGroup = "CW Shared,ou=Groups,dc=mkcollege,dc=ac,dc=uk"
	strLoginScript = "CWStudlogin.bat"
end If

'check for uniqueness of account in Forest...

'declare username to check - this is the UserID from the Recordset grabbed from SQL
'tidy up Firstname and Lastname so that only the first character is capitalised

strStudentID = Trim(objRecordset("USERID"))

newVar1 = Trim(objRecordset("Lastname"))
newLen1 = Len(newVar1) - 1
firstChar1 = UCase(Left(newVar1, 1))
otherChar1 = LCase(Right(newVar1, newLen1))
strLastName = firstChar1 & otherChar1

newVar2 = Trim(objRecordset("Firstname"))
newLen2 = Len(newVar2) - 1
firstChar2 = UCase(Left(newVar2, 1))
otherChar2 = LCase(Right(newVar2, newLen2))
strFirstName = firstChar2 & otherChar2

'we use passwords of the form MKC123456 - strRawPassword contains the trimmed DOB for later use

strRawPassword = Trim(objRecordset("DOB"))
'strUserPath is defined and set to null, which means there is no current user with this ID
'if the user already exists in the forest, strUserPath will be updated with its current DN
Dim strUserPath
strUserPath = ""
dtStart = TimeValue(Now())
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
 
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
 'check to see if the account exists in the Bletchley General 0607 OU
objCommand.CommandText = _
    "<LDAP://ou=0607,ou=BL,ou=MKC Student Accounts,dc=mkcollege,dc=ac,dc=uk>;(&(objectCategory=User)" & _
         "(samAccountName=" & strStudentID & "));samAccountName;subtree"
  
Set objRecordSet2 = objCommand.Execute
'if it doesn't, it'll move to the next case
If objRecordset2.RecordCount = 0 Then
Else
 'if it does then it'll get moved - returns the dn, minus the cn
    strUserPath = "ou=0607,ou=BL,ou=MKC Student Accounts,dc=mkcollege,dc=ac,dc=uk"
End If

objCommand.CommandText = _
    "<LDAP://ou=0607,ou=CW,ou=MKC Student Accounts,dc=mkcollege,dc=ac,dc=uk>;(&(objectCategory=User)" & _
         "(samAccountName=" & strStudentID & "));samAccountName;subtree"
  
Set objRecordSet2 = objCommand.Execute
 
If objRecordset2.RecordCount = 0 Then
Else
    strUserPath = "ou=0607,ou=CW,ou=MKC Student Accounts,dc=mkcollege,dc=ac,dc=uk"
End If

  'check to see if the account exists in the Kiln Farm General 0607 OU
objCommand.CommandText = _
    "<LDAP://ou=0607,ou=KF,ou=MKC Student Accounts,dc=mkcollege,dc=ac,dc=uk>;(&(objectCategory=User)" & _
         "(samAccountName=" & strStudentID & "));samAccountName;subtree"
  
Set objRecordSet2 = objCommand.Execute
 
If objRecordset2.RecordCount = 0 Then
Else
    strUserPath = "ou=0607,ou=KF,ou=MKC Student Accounts,dc=mkcollege,dc=ac,dc=uk"
End If
  'check to see if the account exists in the Kiln Farm Generic 0607 OU

'if an account exists, the dn minus cn is passed via strUserPath
'if it doesn't, strUserPath passes empty string

'everything below is for creating a password in the right format
'newstring is a three part array created by trimming the data in strRawPassword and splitting it via delimiter
'newstring = Split(Replace(Left(strRawPassword,8),"/",","), ",")
'If Len(newstring(0)) < 2 Then newDay = "0" & newstring(0)if its not 2 digits then add a leading zero
'Else newDay = newstring(0)
'End If
'If Len(newstring(1)) < 2 Then newMonth = "0" & newstring(1)if its not 2 digits then add a leading zero
'Else newMonth = newstring(1)
'End If
'newYear = Right(newstring(2),2)take the last two digits of the year
'strPassword = "MKC" & newDay & newMonth & newYear new password is MKCddmmyy


newstring = Split(Replace(strRawPassword,"/",","), ",")
If Len(newstring(0)) < 2 Then
        newDay = "0" & newstring(0)'if its not 2 digits then add a leading zero
Else newDay = newstring(0)
End If
If Len(newstring(1)) < 2 Then
        newMonth = "0" & newstring(1)'if its not 2 digits then add a leading zero
Else newMonth = newstring(1)
End If
newYear = Right(Left(newstring(2),4),2)'take the last two digits of the year
strPassword = "MKC" & newDay & newMonth & newYear 'new password is MKCddmmyy

If strUserPath = "" then 'create a new home folder
Dim objFSO, objFolder, strDirectory
strDirectory = strHomeDir & strStudentID 'this is the full path
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.CreateFolder(strDirectory) 'this line creates the home folder

set objParent = GetObject("LDAP://" & strCopyPath) 'get the campus root
set objUser = objParent.Create("user", "cn=" & strStudentID) 'make  a new user cn=student ID in the campus container
objUser.Put "sAMAccountName", strStudentID 'set pre-W2K logon name
objUser.Put "homeDirectory", strHomeDir & strStudentID 'set home dir
objUser.Put "homeDrive", "U:" 'set home path
objUser.Put "sn", strLastName 'set last name
objUser.Put "givenName", strFirstName 'set first name
objUser.Put "mail", strStudentID & "@mkcollege.ac.uk" 'set email address (for exchange)
objUser.Put "displayName", strStudentID 'set display name
objUser.Put "userPrincipalName", strStudentID & "@mkcollege.ac.uk" 'set UPN
objUser.Put "scriptPath", strLoginScript 'set login script
objUser.SetInfo 'confirm and apply to AD
objUser.SetPassword strPassword 'set password
objUser.Put "pwdLastSet", 0 'make user change at next logon
objUser.AccountDisabled=FALSE 'make account active
objUser.AccountExpirationDate = "01/08/2008"
objUser.SetInfo 'confirm and apply to AD
set objNewUser = GetObject("LDAP://cn=" & strStudentID & "," & strCopyPath) 'open the newly created user for editing
set objISAGroup = GetObject("LDAP://cn=GS-ISA Users,ou=Groups,dc=mkcollege,dc=ac,dc=uk") 'get ISA access group
objISAGroup.add(objUser.ADsPath) 'add to ISA access group
set objLocalAccessGroup = GetObject("LDAP://cn=GS-Local Access,ou=Groups,dc=mkcollege,dc=ac,dc=uk") 'get Local Admin group
objLocalAccessGroup.add(objUser.ADsPath) 'add to Local Admin group
set objSharedAccessGroup = GetObject("LDAP://cn=" & strAccessGroup) 'get Default Shared Access group
objSharedAccessGroup.add(objUser.ADsPath) 'add to Default Shared Access group
else 'this now assumes there was already an account active
'going to check for home drives that need copying
strFile = "c:\data_to_move.bat" ' file that will contain the location of data to be copied
strCheckFolderBL = "\\10.10.1.132\home$\0607\" & strStudentID 'BL possible folder location
strCheckFolderCW = "\\10.4.1.132\home$\0607\" & strStudentID 'CW possible folder location
strCheckFolderKF = "\\10.4.1.150\home$\0607\" & strStudentID 'KF possible folder location

const ForAppending = 8
set objFSO2 = CreateObject("Scripting.FileSystemObject")

If objFSO2.FolderExists(strCheckFolderBL) Then 'if folder exists...
set objFile2 = objFSO2.OpenTextFile(strFile, ForAppending, True) 'append to the file above StudentID, old folder and where it needs to be copied to, as well as time stamp
objFile2.WriteLine("robocopy " & strCheckFolderBL & " " & strHomeDir & strStudentID & " /MOVE /R:2 /W:5 /S")
objFile2.WriteLine("Echo Y| cacls " & strHomeDir & strStudentID & " /t /c /g " & strStudentID & ":F administrators:F")
objFile2.Close
else
end if
If objFSO2.FolderExists(strCheckFolderCW) Then 'if folder exists...
set objFile2 = objFSO2.OpenTextFile(strFile, ForAppending, True) 'append to the file above StudentID, old folder and where it needs to be copied to, as well as time stamp
objFile2.WriteLine("robocopy " & strCheckFolderCW & " " & strHomeDir & strStudentID & " /MOVE /R:2 /W:5 /S")
objFile2.WriteLine("Echo Y| cacls " & strHomeDir & strStudentID & " /t /c /g " & strStudentID & ":F administrators:F")
objFile2.Close
else
end if

If objFSO2.FolderExists(strCheckFolderKF) Then 'if folder exists...
set objFile2 = objFSO2.OpenTextFile(strFile, ForAppending, True) 'append to the file above StudentID, old folder and where it needs to be copied to, as well as time stamp
objFile2.WriteLine("robocopy " & strCheckFolderKF & " " & strHomeDir & strStudentID & " /MOVE /R:2 /W:5 /S")
objFile2.WriteLine("Echo Y| cacls " & strHomeDir & strStudentID & " /t /c /g " & strStudentID & ":F administrators:F")
objFile2.Close
else 'write nowt
End If

'get userid and current location
strUserCN = "CN=" & strStudentID & ","
Set objUser = GetObject("LDAP://" & strCopyPath)
Set objMoveUser = objUser.MoveHere("LDAP://" & strUserCN & strUserPath, vbNullString)
set objEditUser = GetObject("LDAP://cn=" & strStudentID & "," & strCopyPath) 'move the user from the old location to their new one
objEditUser.Put "homeDirectory", strHomeDir & strStudentID 'set new home directory
objEditUser.SetPassword strPassword 'set new password
objEditUser.Put "pwdLastSet", 0 'force change at first logon
objEditUser.AccountDisabled=FALSE 'set account active
objEditUser.AccountExpirationDate = "01/08/2008"
objEditUser.SetInfo 'confirm and apply to AD

End If

'all user creation or movement is now done

'default permissions on home folder are crap and let anyone in, so we need to reset them

'dim objShell
'caclsPath = "%COMSPEC% /c Echo Y| cacls " & strHomeDir & strStudentID & " /t /c /g " & strStudentID & ":F administrators:F" 'create a string containing the cacls commands and the answerfile to confirm
'Set objShell = CreateObject("Wscript.Shell") 'create a windows shell a.k.a dos box
'setPerms = objShell.Run(caclsPath, 2, True) 'set access to student and admins only
objRecordset.moveNext 'go through everything above for the next student...

Loop

objRecordset.Close 'close the collection
objConnection.Close 'close the connection