'MakeLaptopWarning.vbs

'This script creates a script in the All Users Startup prompting them To
'return their laptop within X number of days.  It must be run locally, and can be edited to change
'the default group or person for return, and the consequences for failure to return

'Alan dot Kaplan at va dot gov
'Original 1-9-07, most recent edits 1-25-13 Added support for post XP OS

Option Explicit 
Dim strReturnTo, strConsequences
'Edit these ...
strReturnTo = GuessLocation
' or uncomment and customize below
'strReturnTo = "Your friendly local administrator"
'What happens if they don't return it.  This is message user sees
strConsequences =  "If you fail to return this computer on time, it will no longer allow you to logon."
'End edits


Dim wshShell:Set wshShell = WScript.CreateObject("WScript.Shell")
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim f,iDays, dReturnDate
dim strFile, message
Dim quote: quote=chr(34)
Dim strStartupFolder
message = "This script creates a script in the All Users Startup folderprompting them to " & _
"return their laptop within X number of days.  It must be run locally, and can be edited to change " & _
"the default group or person for return, and the consequences for failure to return." & VbCrLf & VbCrLf  & _
"You must run this as an administrator.  On systems with UAC, you must run from an elevated command prompt. " & _
VbCrLf & VbCrLf & "Return to:"

strReturnTo = InputBox(message,"Return to",strReturnTo)
If strReturnTo = "" Then WScript.Quit

'This is the name of the file written on the user's computer
strFile ="LaptopWarning.vbs"

'XP path
strStartUpFolder = wshShell.ExpandEnvironmentStrings("%AllUsersProfile%"& "\Start Menu\Programs\StartUp\")

If Not fso.FolderExists (strStartUpFolder) Then
	'Post XP OS Path
	strStartUpFolder = wshShell.ExpandEnvironmentStrings("%AllUsersProfile%"& "\Microsoft\Windows\Start Menu\Programs\StartUp\") 
End If 

strFile = strStartupFolder & strFile 

On Error Resume Next 
'Delete original file
If fso.FileExists(strFile) Then  fso.DeleteFile strFile,True
Set f = fso.CreateTextFile (strFile, True)

If Err <> 0 Then 
	MsgBox "Failed to create new file. " & Err.Description,vbCritical + vbOKOnly,"Error"
	WScript.Quit
End If 
	
iDays = InputBox("Return laptop in how many days?","Return Days",30)
dReturnDate = Date + iDays
If dReturnDate = "" Then WScript.Quit
 
dReturnDate =InputBox("Confirm date, " & CStr(FormatDateTime(dReturndate,vbLongDate)),"Confirm", dReturnDate)
If dReturnDate = "" Then 
	WScript.Quit
Else
	WriteOut
	MsgBox "Script written for return date of " & dReturnDate,vbOKOnly,"Done"
End If 

Sub WriteOut() 'Create new script. 
	f.Writeline  "'Created by " & WScript.Name
	f.Writeline  "'Alan Kaplan, Region 3 for " & strReturnTo
	strReturnTo = " to " & strReturnTo
	f.Writeline  "'please do not delete this warning file"
	f.Writeline
	f.Writeline "Option Explicit"
	f.Writeline "Dim wshShell"
	f.Writeline "Dim dReturnDate, strMessage, iButton"
	f.Writeline
	f.Writeline "Dim iDays2Go"
	f.Writeline "Set WshShell = WScript.CreateObject(" & quote & "WScript.Shell" & quote & ")"
	f.Writeline "dReturnDate = #" & dReturnDate & "#"
	f.Writeline "iDays2Go = dReturnDate - Date"
	f.Writeline "'Users may not see this..."
	f.Writeline "If iDays2Go < 0 Then "
	f.Writeline "		strMessage = " & quote & "This laptop must be returned" & strReturnTo & " at once! It was due " & quote & " & _"
	f.Writeline "		" & quote & "to be returned on " & quote & " & FormatDateTime(dReturnDate,vbLongDate)& " & quote & "." & quote & ""
	f.Writeline "		strMessage = strMessage & Vbcrlf & vbcrlf & " & quote & strConsequences & quote 
	f.Writeline "		iButton = vbCritical + vbSystemModal"
	f.Writeline "ElseIf iDays2Go < 7 Then "
	f.Writeline "		strMessage = " & quote & "This laptop must be returned" & strReturnTo & " within " & quote & " & _"
	f.Writeline "		iDays2Go & " & quote & " days, by " & quote & " &	FormatDateTime(dReturnDate,vbLongDate) & " & quote & "." & quote & ""
	f.Writeline "		strMessage = strMessage & Vbcrlf & vbcrlf & " & quote & strConsequences & quote 
	f.Writeline "		iButton = vbExclamation + vbSystemModal"
	f.Writeline "Else "
	f.Writeline "		strMessage = " & quote & "This laptop must be returned" & strReturnTo & " within " & quote & " & _"
	f.Writeline "		iDays2Go & " & quote & " days, by " & quote & " &	FormatDateTime(dReturnDate,vbLongDate)& " & quote & "." & quote & ""
	f.Writeline "		iButton = vbInformation + vbSystemModal"
	f.Writeline "End If "
	f.Writeline
	f.Writeline "MsgBox strMessage,iButton +vbOKOnly," & quote & "Laptop Return Date" & quote
	f.Close
End Sub 

Function  GuessLocation()
	Dim oSI: Set oSI = CreateObject("ADSystemInfo")
	GuessLocation = oSI.SiteName & " IT Support"
End Function