'Constants
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const E_ADS_PROPERTY_NOT_FOUND  = &h8000500D
Const ADS_PROPERTY_CLEAR = 1 
Const ADS_PROPERTY_DELETE = 4

'Objects

Set FSO=CreateObject("Scripting.FileSystemObject")
Set wshShell = WScript.CreateObject ("WSCript.shell")
Set objMessage = CreateObject("CDO.Message")

'Variables
ThisComputer=wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
LogDir="C:\autoextend\log"
WorkdataFolder = "\\mc2m943g\extendfiles\"
  
'Set up logging
'vbscript Date() function returns single digits <10, so pad a 0.....
If Month(Date) < 10 Then
	CurMonth="0" & Month(Date)
Else
	CurMonth=Month(Date)
End If

If Day(Date) < 10 Then 
	CurDay="0" & Day(Date)
Else 
	CurDay=Day(Date)
End If

LogFile=Year(Date) & CurMonth & CurDay & ".txt"
FullLogfilePath=LogDir & "\" & LogFile

If Not FSO.FileExists(FullLogfilePath) Then
	Set Logging=FSO.CreateTextFile(FullLogfilePath, ForAppending)
	Logging.Close
	Set Logging=FSO.OpenTextFile(FullLogFilePath, ForAppending)
Else 
	Set Logging=FSO.OpenTextFile(FullLogFilePath, ForAppending)
End If

 
'Check for Workdata/ID's to term.
  Set folder = fso.GetFolder(WorkDataFolder)
  Set files = folder.Files
  For Each folderIdx In files
  	WorkFile=folderIdx.Name
  	Logging.WriteLine(Date & " " & Time & " Calling main loop for " & WorkDataFolder & "\" & WorkFile)
    FullWorkFilePath=WorkDataFolder & "\" & WorkFile
    Call WorkfileLoop(FullWorkFilePath)
  Next
  
  WScript.Quit
  
Sub WorkFileLoop(FileToParse)
  	'This is the loop that will do the actual user creation.
  	OriginalFileName=FileToParse
   	Set Workfile=FSO.OpenTextFile(FileToParse, ForReading)
   	Do Until WorkFile.AtEndofstream
   		CurrentLine=workfile.readline
   		userdata=split(CurrentLine,"~")
   		UserToExtend=Userdata(0)
   		Extender=UserData(1)
   		TargetDate=UserData(2)
   		'Everything else that might be in this file can be tossed.
   		Exit Do
	Loop   		
   		'Create variables.
   		UserDN=RetrieveValue(userToExtend,"sAMAccountname","distinguishedName")
   		ExtenderDN=RetrieveValue(Extender,"sAMAccountname","distinguishedName")
   		UserDisplayName=RetrieveValue(userToExtend,"sAMAccountName","DisplayName")
   		ExtenderDisplayName=RetrieveValue(Extender,"sAMaccountName","DisplayName")
   		'Done with the workfile.
   		WorkFile.Close
   		Logging.WriteLine(Date & " " & Time & " Extension for " & UserDisplayName & " to " & TargetDate & " applied by " & ExtenderDisplayName)
   		
   		'All variables set.   		
   		
   		Call SetExpirationDate(UserDN,TargetDate)
   		
  		Call SendFinalEmail(UserDisplayName,DateAdd("d",1,TargetDate),ExtenderDisplayName)
   		
   		Call MoveFile(OriginalFileName, "C:\autoextend\workdata\completed\")
   		
End Sub

Sub SendFinalEmail(DispName,Extensiondate,Approver)
	'Generate final email.
	RecipientList=chr(34) & "karl.weckstrom@rbccm.com" & chr(34)
	'RecipientList=chr(34) & requestoremail & chr(34) & ";" & chr(34) & "orderdesk.usa@rbccm.com" & chr(34) & ";" & chr(34) & "dsusapcserver@rbccm.com" & chr(34) & ";" & chr(34) & "CM-USA-NewHireNotification@rbc.com" & chr(34)
	objMessage.Subject = "Extension: " & DispName & " to " & Extensiondate
	objMessage.From = "orderdesk.usa@rbccm.com"
	objMessage.To = RecipientList
	
	strBody = "Account for " & DispName & " has been extended to " & extensionDate & " by " & Approver & "."
	objMessage.TextBody = strBody
	objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mailer.rbc.com"
	objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	objMessage.Configuration.Fields.Update
	objMessage.Send
End Sub
    
Sub MoveFile(sSource,sDestination)
	tmpFilename=Split(sSource,"\")
	sFilename=tmpFilename(UBound(tmpFileName))
	'On Error Resume Next
	If FSO.FileExists(sDestination & sFilename) Then FSO.DeleteFile(sDestination & sFileName)
	Set objFileCopy = FSO.GetFile(sSource)
	objFileCopy.Move(sDestination)
End Sub

Function RetrieveValue(Data,DataType,ObjName)
	'WScript.Echo datatype
	'WScript.Echo Data
	'WScript.Echo objName
	Set oRootDSE = GetObject("LDAP://rootDSE")
	Set oConnection = CreateObject("ADODB.Connection")
	oConnection.Open "Provider=ADsDSOObject;"
	Set oCommand = CreateObject("ADODB.Command")
	oCommand.ActiveConnection = oConnection
	If DataType="EmployeeID" then
		oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & ">;(&(objectCategory=User)(" & DataType & "=" & Data & "*));" & objName & ";subtree"
	Else
		oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & ">;(&(objectCategory=User)(" & DataType & "=" & Data & "));" & objName & ";subtree"
	End If
	'WScript.Echo oCommand.CommandText
	Set oRecordSet = oCommand.Execute
	on error resume Next
	'WScript.Echo oRecordSet.Fields(objName)
	RetrieveValue = oRecordSet.Fields(objName)
	Set oRecordSet = Nothing
	Set oCommand = Nothing
	Set oConnection = Nothing
	Set oRootDSE = Nothing
End function


Sub SetExpirationDate(userCN,passedDate)
	Set objUser=GetObject("LDAP://" & UserCN)
	objuser.AccountExpirationDate=DateAdd("d",1,PassedDate)
	objUser.Setinfo
End Sub