<%@ LANGUAGE="VBSCRIPT" %> <% ' Script to Verify Student is Registered for Engineering Courses 'Constants for the NameTranslate object. EngineeringDate = #09/15/2011# NonEngineeringDate = #1/15/2011# Const ADS_NAME_INITTYPE_GC = 3 Const ADS_NAME_TYPE_NT4 = 3 Const ADS_NAME_TYPE_1779 = 1 Const ADS_SCOPE_SUBTREE = 2 On error resume next 'On error resume next Sub Sleep(intSeconds) dteStart = Time() dteEnd = DateAdd("s", intSeconds, dteStart) While dteEnd > Time() DoNothing Wend End Sub Sub DoNothing 'While/Wend has quirks when it is empty End Sub ''//This connects to the DB sub verifyuser() set adoConn =Createobject("ADODB.Connection") set adoRS = Createobject("ADODB.Recordset") adoConn.Open "DSN=simfa8" adoRS.ActiveConnection = adoConn sql_select = "SELECT * FROM simfa8 WHERE id = '" & RedID & "'" 'select statement for the RedID set RS = adoConn.Execute(sql_select) 'executes the command and stores it to the table RS if not RS.eof then Found = True FullName = RS("name") LastName = PCase(Left(FullName,(InStrRev(RS("name"),",") - 1))) Name = Split(Mid(FullName,(InStrRev(RS("name"),",") + 1))) if Lastname <> Pcase(flname) then %> Your last name does not match this redid. <% RS.close adoConn.close set RS = nothing set adoConn = nothing set adoRS = nothing Response.end End if If UBound(Name)=0 Then MidInitial = "nmn" Else MidInitial = UCase(Left(Name(1),1)) End if Select Case CLng(RS("major_code")) Case 441001 Major = "Aerospace" Case 441003 Major = "Aerospace" Case 441005 Major = "Aerospace" Case 441070 Major = "Aerospace" Case 442001 Major = "Civil" Case 442002 Major = "Environmental" Case 442005 Major = "Environmental" Case 442010 Major = "Construction" Case 442030 Major = "Construction" Case 442025 Major = "Civil" Case 442075 Major = "Civil" Case 442085 Major = "Civil" Case 442096 Major = "Civil" Case 442095 Major = "Environmental" Case 443001 Major = "Electrical" Case 444001 Major = "Mechanical" Case 444020 Major = "Mechanical" Case 444050 Major = "Mechanical" Case 444070 Major = "Mechanical" Case 445001 Major = "Computer" Case 446001 Major = "Mechanical" Case 446002 Major = "Mechanical" Case 446003 Major = "Mechanical" Case 446004 Major = "Mechanical" Case 447001 Major = "Mechanical" Case 447010 Major = "Mechanical" Case Else Major = "NonEngineering" End Select TempName = Split(LastName) Select Case UBound(TempName) Case 0 LName = TempName(0) Case 1 LName = TempName(0) + TempName(1) Case 2 LName = TempName(0) + TempName(1) + TempName(2) Case 3 LName = TempName(0) + TempName(1) + TempName(2) + TempName(3) End Select UserName = Left(LName,7) & UCase(Left(Name(0),1)) & Right(RedID, 2) Password = LCase(Mid(LName,2,1)) & LCase(Left(LName,1)) & UCase(Mid(Name(0),2,1)) & LCase(Left(Name(0),1))& Mid(RedID, 2, 4) Found = True else Found = False End if If Found <> True Then %> No User Found under this Red ID number <% Response.end Found = FALSE End If RS.close adoConn.close set RS = nothing set adoConn = nothing set adoRS = nothing end sub Sub HomeDir() strHomeFolder = strHome & strUser 'Response.End Set objFSO = CreateObject("Scripting.FileSystemObject") Set objShell = CreateObject("Wscript.Shell") If strHomeFolder <> "" Then If Not objFSO.FolderExists(strHomeFolder) Then 'On error resume next objFSO.CreateFolder strHomeFolder If Err.Number <> 0 Then On Error GoTo 0 'Wscript.Echo "Cannot create: " & strHomeFolder End If On Error GoTo 0 End If 'On error resume next If objFSO.FolderExists(strHomeFolder) Then 'Assign user permission to home folder. intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls "_ & strHomeFolder & " /t /c /g Administrators:F "_ & "SYSTEM:F "_ & strUser & ":F", 2, True) If intRunError <> 0 Then 'Wscript.Echo "Error assigning permissions for user " _ '& strUser & " to home folder " & strHomeFolder calcserror = 1 End If End If End If Set objFSO = Nothing Set objShell = Nothing End Sub Sub JoinGroup() strUserDNS = "CN=" & cName & "," & sOuDomainPath strGroupDNS = "CN=Students,CN=Users,DC=Engineering,DC=sdsu" Set objUser = GetObject("LDAP://" & strUserDNS) Set objGroup = GetObject("LDAP://" & strGroupDNS) objGroup.add(objUser.ADsPath) objGroup.SetInfo Set objUser = Nothing Set objGroup = Nothing End Sub Function PCase(strIn) strOut = "" boolUp = True For i = 1 to Len(strIn) c = Mid(strIn, i, 1) If c = " " or c = "'" or c = "-" then strOut = strOut & c boolUp = True Else If boolUp then tc=UCase(c) Else tc=LCase(c) End If strOut = strOut & tc boolUp = False End If Next PCase = strOut End Function Sub MoveUser() 'On error resume next strTargetOU = "OU=" & Major & ",OU=Students,DC=Engineering,DC=SDSU" strUserDN = "CN=" & displayName & ",OU=" & OU & ",OU=Students,DC=Engineering,DC=SDSU" Set objTargetOU = GetObject("LDAP://" & strTargetOU) Set objUser = GetObject("LDAP://" & strUserDN) objTargetOU.MoveHere objUser.ADsPath, VBNullString strDN = strUserDN 'call Sleep(20) ' ////////////////////////////////////////////////////////////////////////////////// '/all of this just reconnects to the AD to refresh the info in the event of a move// Set oConnection = CreateObject("ADODB.Connection") 'connects to AD Set objCommand = CreateObject("ADODB.Command") 'Sets up the command for AD oConnection.Provider = "ADsDSOObject" 'AD provider oConnection.Open "Active Directory Provider" Set objCommand.ActiveConnection = oConnection 'the connection for the command objCommand.Properties("Page Size") = 1000 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 'actual command to sql-select the distinguished name and sAMAccountname fomr AD objCommand.CommandText = _ "SELECT distinguishedName, saMAccountname, displayName, cn FROM 'LDAP://" & DNSDomain &_ "' WHERE objectCategory='user' AND physicalDeliveryOfficeName=" & RedID Set objRecordSet = objCommand.Execute objRecordSet.MoveFirst set oConnection = nothing set objCommand = nothing set objRecordSet = nothing 'call CheckAD_OU1(RedID,Major) Set objUser = Nothing Set objTargetOU = Nothing '/////////////////////////////////////////////////////////////////////////////////// End Sub Function CheckAD_OU(RedID,Major) 'On error resume next err.clear Dim UName, arrPath Set oRootDSE = GetObject("LDAP://RootDSE") DNSDomain = oRootDSE.Get("DefaultNamingContext") 'All of this connects to active directory and selects the name from the active directory Set oConnection = CreateObject("ADODB.Connection") 'connects to AD Set objCommand = CreateObject("ADODB.Command") 'Sets up the command for AD oConnection.Provider = "ADsDSOObject" 'AD provider oConnection.Open "Active Directory Provider" Set objCommand.ActiveConnection = oConnection 'the connection for the command objCommand.Properties("Page Size") = 1000 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 'actual command to sql-select the distinguished name and sAMAccountname fomr AD objCommand.CommandText = _ "SELECT distinguishedName, saMAccountname, displayName, cn FROM 'LDAP://" & DNSDomain &_ "' WHERE objectCategory='user' AND physicalDeliveryOfficeName=" & RedID Set objRecordSet = objCommand.Execute if objRecordSet.EOF then checkAD_OU = False set oConnection = nothing set objCommand = nothing set objRecordSet = nothing Exit Function Else objRecordSet.MoveFirst strDN = "" UName = "" arrPath = "" OU = "" CheckAD_OU = False Do Until objRecordSet.EOF strDN = objRecordSet.Fields("distinguishedName").Value UName = objRecordSet.Fields("saMAccountName").Value displayName = objRecordSet.Fields("cn").Value arrPath = Split(strDN, ",") intLength = Len(arrPath(1)) intNameLength = intLength - 3 OU = Right(arrPath(1), intNameLength) If OU <> "" then If LCase(OU) <> LCase(Major) Then change_major = 1 Call MoveUser() CheckAD_OU = True set oConnection = nothing set objCommand = nothing set objRecordSet = nothing Exit Function Else End If End If objRecordSet.MoveNext Loop End If If OU <> "" Then CheckAD_OU = True Else CheckAD_OU = False End If set oConnection = nothing set objCommand = nothing set objRecordSet = nothing End Function Sub RenewResetUserAccount() Set oLDAP = GetObject("LDAP://" & sOuDomainPath) 'Response.End Set oUser = GetObject("LDAP://" & strDN & "") oUser.Put "sAMAccountName", sUserName oUser.SetInfo oUser.DisplayName = cName oUser.physicalDeliveryOfficeName = RedID oUser.FullName = cName 'Display name. oUser.GivenName = fName oUser.userPrincipalName = sUserName & "@engineering.sdsu" oUser.Initials = Initial oUser.Sn = lName oUser.SetPassword Password oUser.Mail = Email oUser.Put("HomeDrive"),"Z" oUser.HomeDirectory = "\\tera\" & Major & "\" & sUsername oUser.LoginScript = "StudentLogOn.vbs" intPwdValue = 0 oUser.Put "PwdLastSet", intPwdValue If Major = "NonEngineering" Then oUser.Description = Major & " " & "Student" Else oUser.Description = Major & " " & "Engineering Student" End If If Major = "NonEngineering" Then oUser.AccountExpirationDate = NonEngineeringDate Else oUser.AccountExpirationDate = EngineeringDate End If oUser.SetInfo Set oUser = Nothing End Sub sub calcs() 'CaclsExcel.vbs 'VBScript to set Home Folder Permission 'Version 1.0 - August 2007 '---------------------------------------------------------' 'Option Explicit 'Create a shell for cmd and CACLS Set objShell = CreateObject("Wscript.Shell") Set objFSO = CreateObject("Scripting.FileSystemObject") strUser = Username strOldUser = Left(Lastname,6) & UCase(MidInitial) & UCase(Left(Name(0),1)) strMajor = Major if change_major = 1 then strOldHome = "\\tera\students\" & OU & "\" & StrOldUser strOldHome1 = "\\tera\students\" & OU & "\" & Username else strOldHome = "\\tera\students\" & strMajor & "\" & StrOldUser end if strNewHomedir = "\\tera\students\" & strMajor & "\" & strUser If objFSO.FolderExists(strOldHome) then ' this checks to make sure the 'old folder doesnt exist, if it does it moves it to the new folder. if objFSO.FolderExists(strNewHomedir) Then 'if the new folder exists already, 'it will just copy the contents from the old one to the new one. Set folder = objfso.GetFolder(strOldHome) 'checks to see file in old directory Set files = folder.Files if files.count = 0 then ' dont do anything if nothing is in there objfso.deletefolder strOldHome else ' something is in the old folder, copy everything strNewHomedir1 = strNewHomedir & "\" 'actually puts directories in the folder stroldcopyfolder = strOldHome & "\*.*" objfso.MoveFile stroldcopyfolder, strNewHomedir1 stroldcopyfolder = strOldHome & "\*" objfso.MoveFolder stroldcopyfolder, strNewHomedir1 if err.number = 0 then objfso.deletefolder strOldHome end if err.clear end if else objFSO.MoveFolder strOldHome , strNewHomedir if err.number = 0 then objfso.deletefolder strOldHome end if err.cler end if ElseIF objFSO.FolderExists(strOldHome1) then 'for when a user is moving majors... if objFSO.FolderExists(strNewHomedir) Then 'if the new folder exists already, 'it will just copy the contents from the old one to the new one. Set folder = objfso.GetFolder(strOldHome1) 'checks to see file in old directory Set files = folder.Files if files.count = 0 then ' dont do anything if nothing is in there 'wscript.echo "No files in old home directory, deleting " & strOldHome objfso.deletefolder strOldHome1 else ' something is in the old folder, copy everything strNewHomedir1 = strNewHomedir & "\" 'actually puts directories in the folder stroldcopyfolder = strOldHome1 & "\*.*" objfso.MoveFile stroldcopyfolder, strNewHomedir1 stroldcopyfolder = strOldHome1 & "\*" objfso.MoveFolder stroldcopyfolder, strNewHomedir1 if err.number = 0 then objfso.deletefolder strOldHome1 end if err.clear end if else objFSO.MoveFolder strOldHome1 , strNewHomedir if err.number = 0 then objfso.deletefolder strOldHome1 end if err.cler end if end if strHome = "\\tera\students\" & strMajor & "\" set objFSO = nothing set objShell = nothing call HomeDir() ' Subroutine to create folder if not already created and set permissions end sub Sub CreateUserAccount(sOUDomainPath, cName, sUsername) On error resume next Set oLDAP = GetObject("LDAP://" & sOuDomainPath) If Err.Number <> 0 Then On Error GoTo 0 'Wscript.Echo "Unable to bind to container: " & sOUDomainPath 'Wscript.Quit End If 'WScript.Echo cName & " " & sUserName Set oUser = oLDAP.Create("user","cn=" & cName) oUser.Put "sAMAccountName", sUserName oUser.SetInfo oUser.AccountDisabled = False oUser.SetInfo If Major = "NonEngineering" Then oUser.Description = Major & " " & "Student" Else oUser.Description = Major & " " & "Engineering Student" End If oUser.physicalDeliveryOfficeName = RedID oUser.FullName = cName 'Display name. oUser.DisplayName = cName oUser.GivenName = fName oUser.userPrincipalName = sUserName & "@engineering.sdsu" oUser.Initials = Initial oUser.Sn = lName oUser.SetPassword Password oUser.Mail = Email oUser.Put("HomeDrive"),"Z" oUser.HomeDirectory = "\\tera\" & Major & "\" & sUsername oUser.LoginScript = "StudentLogOn.vbs" intPwdValue = 0 oUser.Put "PwdLastSet", intPwdValue If Major = "NonEngineering" Then oUser.AccountExpirationDate = NonEngineeringDate Else oUser.AccountExpirationDate = EngineeringDate End If oUser.SetInfo 'Call CreateHomeDirectory() Call JoinGroup() Set oUser = Nothing Set oLDAP = Nothing End Sub sub sendmail() Set ObjSendMail = CreateObject("CDO.Message") 'This section provides the configuration information for the remote SMTP server. 'Send the message using the network (SMTP over the network). ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="attila.sdsu.edu" ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'Use SSL for the connection (True or False) ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 ObjSendMail.Configuration.Fields.Update 'End remote SMTP server configuration section== ObjSendMail.To = Email ObjSendMail.Subject = "College of Engineering User Account Information" ObjSendMail.From = "HelpDesk@engineering.sdsu.edu" body = "

College of Engineering
User Account Information

" body = body & "Date: " & DateTime & "
" body = body & "Request: " & Rqst & "
" body = body & "Name: " & FirstName & " " & MidName & " " & LastName & "
" body = body & "RedID Number: " & RedID & "
" body = body & "Major: " & major & "
" body = body & "Email: " & Email & "

" body = body & "

Account Request Submitted with the above information


" body = body & "It has been successfully created. To log on, use the following information for the first logon:
" body = body & "

Username: " & UserName & "
" body = body & "Password: " & Password & "

" ' we are sending a text email.. simply switch the comments around to send an html email instead ObjSendMail.HTMLBody = body 'ObjSendMail.TextBody = "this is the body" ObjSendMail.Send Set ObjSendMail = Nothing End Sub 'On error resume next ' //////////////////////////////////// ' //The code Starts Below here//////// ' //It renews or creates an account // '//////////////////////////////////// Dim RedID, Major, UserName, MidInitial, Password, OU, displayName, FullName, LastName, name, rqst Dim Email, fName, lName, mInitial, cName, sOUDomainPath, strDN, midname, firstname, objsendmail, body Dim formmajor, ffname, flname, fmname, fusername, change_major, calcserror Dim strHomeFolder, strHome, strUser, strMajor, stroldcopyfolder, strNewHomedir1 Dim objFSO, objShell, intRunError, strOldUser, strOldHome, strNewHomedir change_major = 0 calcserror = 0 RedId = trim(Request.form("RedID")) formmajor = trim(request.form("major")) ffname = trim(request.form("FirstName")) flname = trim(request.form("LastName")) fmname = trim(request.form("MiddleName")) fusername = trim(request.form("UserName")) requesttype = trim(request.form("Request")) email = trim(request.form("Email")) call verifyuser() 'connects to Dr. Paolini's server to verify the information, need to use this. fName = Name(0) lName = Lastname Initial = MidInitial If LCase(MidInitial) = "nmn" Then cName = PCase(fName) & " " & PCase(lName) Else cName = PCase(fName) & " " & UCase(Initial) & ". " & PCase(lName) & "" End If sOUDomainPath = "OU=" & Major & ",OU=Students,DC=Engineering,DC=sdsu" sUsername = Username if requesttype = "NA" then If CheckAD_OU (RedID,Major) = True Then %> You already have an account under this RedID, if you would like to renew your account, please go back and select "Renew Account"
<% Else strUser = Username strMajor = Major strHome = "\\tera\students\" & strMajor & "\" Call CreateUserAccount(sOUDomainPath, cName, sUsername) Call HomeDir() DateTime = NOW Rqst = requesttype 'UserName = Request.querystring("UserName") 'LastName = Request.querystring("LastName") MidName = fmname FirstName = PCase(fName) 'RedID = Request.querystring("RedID") 'Major = Request.querystring("Major") 'Email = Request.querystring("Email") set AccountRequestDB = CreateObject("ADODB.Connection") set accountRS = Createobject("ADODB.Recordset") AccountRequestDB.ConnectionTimeout = 5 AccountRequestDB.CommandTimeout = 10 AccountRequestDB.open "DSN=StudentAccountRequests" accountRS.ActiveConnection = AccountRequestDB theSQL = "insert into acct_requests " theSQL = theSQL & "( Rqst, UserName, Pass, FirstName, MiddleName, LastName, RedID, " theSQL = theSQL & "Major, Email )" theSQL = theSQL & " values ( '"&Rqst&"', '"&UserName&"', '"&Password&"', '"&FirstName&"', '"&MidName&"', '"&LastName&"', '" theSQL = theSQL & RedID&"', '"&Major&"', '"&Email&"' )" AccountRequestDB.Execute(theSQL) AccountRequestDB.close set AccountRequestDB = Nothing set theSQL = nothing call sendmail() %> <%=body%> <% End If else If CheckAD_OU (RedID,Major) = True Then 'WScript.Echo "Returned User Account Found" strUser = Username strMajor = Major strHome = "\\tera\students\" & strMajor & "\" Call RenewResetUserAccount() Call calcs() DateTime = NOW Rqst = requesttype 'UserName = Request.querystring("UserName") 'LastName = Request.querystring("LastName") MidName = PCase(fmname) FirstName = PCase(fName) 'RedID = Request.querystring("RedID") 'Major = Request.querystring("Major") 'Email = Request.querystring("Email") set AccountRequestDB = CreateObject("ADODB.Connection") set accountRS = Createobject("ADODB.Recordset") AccountRequestDB.ConnectionTimeout = 5 AccountRequestDB.CommandTimeout = 10 AccountRequestDB.open "DSN=StudentAccountRequests" accountRS.ActiveConnection = AccountRequestDB theSQL = "insert into acct_requests " theSQL = theSQL & "( Rqst, UserName, Pass, FirstName, MiddleName, LastName, RedID, " theSQL = theSQL & "Major, Email )" theSQL = theSQL & " values ( '"&Rqst&"', '"&UserName&"', '"&Password&"', '"&FirstName&"', '"&MidName&"', '"&LastName&"', '" theSQL = theSQL & RedID&"', '"&Major&"', '"&Email&"' )" AccountRequestDB.Execute(theSQL) AccountRequestDB.close set AccountRequestDB = Nothing set theSQL = nothing call sendmail() %> <%=body%> <% Else %> You do not have an account yet. If you would like to create and account, please go back and select "Create Account"
<% End If End If %>