<%@ 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
%>