option explicit
' setCleanMGR.vbs - creates a cleanmgr.exe set and creates a shortcut to run that disk cleanup

'------------------------------------
' variables
'------------------------------------
Const HKEY_CLASSES_ROOT   = &H80000000
Const HKEY_CURRENT_USER   = &H80000001
Const HKEY_LOCAL_MACHINE  = &H80000002
Const HKEY_USERS          = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const SETNUMBER = 3
Const DEBUGGING=FALSE

dim objShell, objReg
dim computer
dim isVista, osVersion

dim results
computer="."
'------------------------------------

'------------------------------------
' main routine
'------------------------------------
isVista=checkOS()
if isVista=TRUE then
	If WScript.Arguments.length =0 Then
        Set objShell = CreateObject("Shell.Application")
        'Pass a bogus argument with leading blank space, say [ uac]
        if DEBUGGING=TRUE then
            objShell.ShellExecute "cscript.exe", Chr(34) & WScript.ScriptFullName & Chr(34) & " uac", "", "runas", 1
        else
            objShell.ShellExecute "wscript.exe", Chr(34) & WScript.ScriptFullName & Chr(34) & " uac", "", "runas", 1
        end if
	Else
	    results=backupRegKey()
	    if results=TRUE then
            results=configureItVista()
    		results=shortcutIt()
    		results=doSchedule()
    		msgbox osVersion & " - installation complete" & vbCRLF & "A shortcut has been added to your desktop to run disk cleanup"
    	else
    	    wscript.echo "Failed to backup registry key, install aborted."
    	end if
	End If
else
	    results=backupRegKey()
	    if results=TRUE then
        	results=configureItXP()
    		results=shortcutIt()
    		results=doSchedule()
    		msgbox osVersion & " - installation complete" & vbCRLF & "A shortcut has been added to your desktop to run disk cleanup"
    	else
    	    wscript.echo "Failed to backup registry key, install aborted."
    	end if
end if
'------------------------------------

'------------------------------------
function CheckOS()
    dim objWMIService, objOS, osInfo
    dim results
    results=FALSE
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & computer & "\root\cimv2")
    Set objOS = objWMIService.ExecQuery ("select * from Win32_OperatingSystem where Primary=true")
    For Each osInfo in objOS
	    osVersion=osInfo.Caption
	    if instr(osVersion,"Vista") then results=TRUE
    Next
    checkOS=results
    set osInfo=nothing
    set objOS=nothing
    set objWMIService=nothing
end function
'------------------------------------

'------------------------------------
function configureItVista()
    dim i, results
    dim hive(19)
    dim key(19)
    dim valtype(19)
    dim valname(19)
    dim val(19)

    for i=0 to ubound(hive)-1
        hive(i)=HKEY_LOCAL_MACHINE
        valtype(i)=REG_DWORD
        valname(i)="StateFlags000" & SETNUMBER
        val(i)=SETNUMBER
    next
    key(0)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Active Setup Temp Folders"
    key(1)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Downloaded Program Files"
    val(1)=0
    key(2)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Hibernation File"
    val(2)=0
    key(3)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Internet Cache Files"
    key(4)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Memory Dump Files"
    key(5)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Old ChkDsk Files"
    key(6)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Previous Installations"
    val(6)=0
    key(7)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Recycle Bin"
    val(7)=0
    key(8)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Setup Log Files"
    key(9)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\System error memory dump files"
    key(10)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\System error minidump files"
    key(11)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Temporary Files"
    key(12)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Temporary Setup Files"
    key(13)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Thumbnail Cache"
    val(13)=0
    key(14)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Upgrade Discarded Files"
    val(14)=0
    key(15)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Windows Error Reporting Archive Files"
    key(16)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Windows Error Reporting Queue Files"
    key(17)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Windows Error Reporting System Archive Files"
    key(18)="SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\VolumeCaches\Windows Error Reporting System Queue Files"

	set objShell=CreateObject("WScript.Shell")
	Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & computer & "\root\default:StdRegProv")
    results=deleteCOF()
    for i=0 to ubound(hive)-1
        results=doCheckKey(hive(i),key(i))
        if results=TRUE then
            results=doWriteValue(hive(i),key(i),valtype(i),valname(i),val(i))
        end if
    next
	set objReg=nothing
	set objShell=nothing
end function
'------------------------------------

'------------------------------------
function configureItXP()
    dim i, results
    dim hive(15)
    dim key(15)
    dim valtype(15)
    dim valname(15)
    dim val(15)

    for i=0 to ubound(hive)-1
        hive(i)=HKEY_LOCAL_MACHINE
        valtype(i)=REG_DWORD
        valname(i)="StateFlags000" & SETNUMBER
        val(i)=SETNUMBER
    next

    key(0)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Active Setup Temp Folders"
    key(1)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Content Indexer Cleaner"
    key(2)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Downloaded Program Files"
    val(2)=0
    key(3)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Internet Cache Files"
    key(4)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Memory Dump Files"
    key(5)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Microsoft Office Temp Files"
    key(6)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Microsoft_Event_Reporting_2.0_Temp_Files"
    key(7)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Office Setup Files"
    val(7)=0
    key(8)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Offline Pages Files"
    key(9)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Old ChkDsk Files"
    key(10)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Recycle Bin"
    val(10)=0
    key(11)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Remote Desktop Cache Files"
    key(12)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Setup Log Files"
    key(13)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Temporary Files"
    key(14)="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\WebClient and WebPublisher Cache"

	set objShell=CreateObject("WScript.Shell")
	Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & computer & "\root\default:StdRegProv")

    results=deleteCOF()
    for i=0 to ubound(hive)-1
        results=doCheckKey(hive(i),key(i))
        if results=TRUE then
            results=doWriteValue(hive(i),key(i),valtype(i),valname(i),val(i))
        end if
    next
	set objReg=nothing
	set objShell=nothing
end function
'------------------------------------

'------------------------------------
function deleteCOF()
    on error resume next
    dim val, key, results
    key="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches\Compress old files"
    results=objShell.RegRead("HKEY_LOCAL_MACHINE\" & key & "\")
    if err.number=0 then
        err.clear
        objReg.DeleteKey HKEY_LOCAL_MACHINE, key
        if err.number=0 then
            deleteCOF=TRUE
            if DEBUGGING=TRUE then wscript.echo "Deleted Compress old files key"
        else
            deleteCOF=FALSE
            if DEBUGGING=TRUE then wscript.echo "Failed"
        end if
    else
        deleteCOF=TRUE
        if DEBUGGING=TRUE then wscript.echo "Compress old files key already deleted"
    end if
    on error goto 0
end function
'------------------------------------

'------------------------------------
function doCheckKey(pHive,pKey)
    if DEBUGGING=FALSE then on error resume next
    dim val, tmpHive
    select case pHive
    case HKEY_CLASSES_ROOT
        tmpHive="HKEY_CLASSES_ROOT"
    case HKEY_CURRENT_USER
        tmpHive="HKEY_CURRENT_USER"
    case HKEY_LOCAL_MACHINE
        tmpHive="HKEY_LOCAL_MACHINE"
    case HKEY_USERS
        tmpHive="HKEY_USERS"
    case HKEY_CURRENT_CONFIG
        tmpHive="HKEY_CURRENT_CONFIG"
    end select
    
    val=objShell.RegRead(tmpHive & "\" & pKey & "\")
    if err.number=0 then
        doCheckKey=TRUE
    else
        doCheckKey=FALSE
        if DEBUGGING=TRUE then wscript.echo "Check failed"
    end if
    on error goto 0
end function
'------------------------------------

'------------------------------------
function doCreateKey(pHive,pKey)
    if DEBUGGING=FALSE then on error resume next
    objReg.CreateKey pHive,pKey
    if err.number=0 then
        doCreateKey=TRUE
    else
        doCreateKey=FALSE
    end if
    on error goto 0
end function
'------------------------------------

'------------------------------------
function doWriteValue(pHive,pKey,pValType,pValName,pVal)
    if DEBUGGING=FALSE then on error resume next

    select case pValType
    case REG_SZ
    	objReg.SetStringValue pHive,pKey,pValName,pVal
    case REG_EXPAND_SZ
        err.Raise 8,"","Unsupported value type","",""
    case REG_BINARY
        err.Raise 8,"","Unsupported value type","",""
    case REG_DWORD
    	objReg.SetDWORDValue pHive,pKey,pValName,pVal
        if DEBUGGING=TRUE then wscript.echo pVal
    case REG_MULTI_SZ
        err.Raise 8,"","Unsupported value type","",""
    case else
        err.Raise 9,"","Invalid value type","",""
    end select
    
    if err.number=0 then
        doWriteValue=TRUE
    else
        doWriteValue=FALSE
    end if

    on error goto 0
end function
'------------------------------------

'------------------------------------
function doReadValue(pHive,pKey,pValType,pValName,pVal)
    if DEBUGGING=FALSE then on error resume next
    dim results,val
    
    select case pValType
    case REG_SZ
    	objReg.GetStringValue pHive,pKey,pValName,results
    case REG_EXPAND_SZ
        err.Raise 8,"","Unsupported value type","",""
    case REG_BINARY
        err.Raise 8,"","Unsupported value type","",""
    case REG_DWORD
    	objReg.SetDWORDValue pHive,pKey,pValName,results
    case REG_MULTI_SZ
        err.Raise 8,"","Unsupported value type","",""
    case else
        err.Raise 9,"","Invalid value type","",""
    end select
  
    if err.number=0 then
        doReadValue=TRUE
    else
        results=err.Description
        doReadValue=FALSE
    end if

    if DEBUGGING=TRUE then wscript.echo results
    
    on error goto 0
end function
'------------------------------------

'------------------------------------
function shortcutIt()
    if DEBUGGING=FALSE then on error resume next
    dim objShell,objLink,objDesktop,shortcutcount
    dim apppath, workdir, iconpath, shortcutname, arguments
    shortcutcount=0
    
	workdir="%HOMEDRIVE%%HOMEPATH%"
	apppath="%windir%\system32\cleanmgr.exe"
	arguments="/d c: /sagerun:" & SETNUMBER
	shortcutname="Disk cleanup"
	iconpath="%windir%\system32\cleanmgr.exe,0"

	set objShell=CreateObject("WScript.Shell")
	objDesktop=objShell.SpecialFolders("Desktop")
	Set objLink = objShell.CreateShortcut(objDesktop & "\" & shortcutname & ".lnk")
	objLink.Description=shortcutname
	objLink.IconLocation=iconpath
	objLink.TargetPath=apppath
	objLink.Arguments=arguments
	objLink.WorkingDirectory=workdir
	objLink.Save

    if err.number=0 then
        shortcutcount=1
    end if

	workdir="%windir%"
	apppath="%SystemRoot%\system32\dfrg.msc"
	arguments=""
	shortcutname="Defrag"
	iconpath="%SystemRoot%\system32\SHELL32.dll,80"

	set objShell=CreateObject("WScript.Shell")
	objDesktop=objShell.SpecialFolders("Desktop")
	Set objLink = objShell.CreateShortcut(objDesktop & "\" & shortcutname & ".lnk")
	objLink.Description=shortcutname
	objLink.IconLocation=iconpath
	objLink.TargetPath=apppath
	objLink.Arguments=arguments
	objLink.WorkingDirectory=workdir
	objLink.Save

    if err.number=0 then
        shortcutcount=shortcutcount+1
    end if

    if shortcutcount=2 then
        shortcutIt=TRUE
    else
        shortcutIt=FALSE
    end if

    set objLink=nothing
    set objDesktop=nothing
    set objShell=nothing
    on error goto 0
end function
'------------------------------------

'------------------------------------
function backupRegKey()
    dim cmdline,oShell,result
	cmdline = "regedit /e %systemroot%\VolumeCaches.reg.txt HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches"
	set oShell = CreateObject("WScript.Shell")
	result = oShell.Run(cmdline, 0, TRUE)
	if result <> 0 then
	   backupRegKey=FALSE
	else
	   backupRegKey=TRUE
	end if
end function    
'------------------------------------

'------------------------------------
function doSchedule()
    if DEBUGGING=FALSE then on error resume next

	dim objNet
	dim username, domain, password, msgtext
   	dim cmd

	set objNet=createobject("wscript.network")
	username=objNet.username
	domain=objNet.userdomain
	if len(domain)=0 then
		uid=username
	else
		username=domain & "\" & username
	end if

	msgtext= "Please enter your password so that a " &_
		"disk maintenance task can be scheduled. This is " &_
		"the password you login to your computer with.<br><br>" &_
		"Just click OK if you don't have a password on " &_
		"your computer or don't wish to schedule the task.<br><br>" &_
		"You are currently logged on as<br><b>" & username & "</b>"

	password=getPassword(msgtext)
    if password="" then
        msgbox "No task will be scheduled"
    else
    	dim objCMD
        cmd="schtasks /create /RU " & username & " /RP " & password & " /SC WEEKLY /D FRI /ST ""16:00:00"" /TN ""Disk Cleanup"" /TR ""cleanmgr /d c: /sagerun:" & SETNUMBER & """"
        doRunCMD cmd
    end if

    Set objNet=nothing
    on error goto 0
end function
'------------------------------------

'------------------------------------
sub doRunCMD(cmd)
    if DEBUGGING=FALSE then on error resume next
    dim objCMD, results
    set objCMD=createobject("wscript.shell")
    results=objCMD.run(cmd,1,TRUE)
    if results=0 then
        msgbox("Task successfully scheduled")
    else
        results=msgbox("Task creation failed, try again?",vbYesNo)
        if results=vbYes then
            results=doSchedule()
        else
        end if
    end if

    Set objCMD=nothing
    on error goto 0
end sub
'------------------------------------

'------------------------------------
Function GetPassword(myPrompt)
' This function uses Internet Explorer to
' create a dialog and prompt for a password.
'
' Argument:   [string] prompt text, e.g. "Please enter password:"
' Returns:    [string] the password typed in the dialog screen
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
    Dim objIE
    ' Create an IE object
    Set objIE = CreateObject( "InternetExplorer.Application" )
    ' specify some of the IE window's settings
    objIE.Navigate "about:blank"
    objIE.Document.Title = "Schedule disk maintenance"
    objIE.ToolBar        = False
    objIE.Resizable      = False
    objIE.StatusBar      = False
    objIE.Width          = 400
    objIE.Height         = 400
    ' Center the dialog window on the screen
    With objIE.Document.ParentWindow.Screen
        objIE.Left = (.AvailWidth  - objIE.Width ) \ 2
        objIE.Top  = (.Availheight - objIE.Height) \ 2
    End With
    ' Wait till IE is ready
    Do While objIE.Busy
        WScript.Sleep 200
    Loop
    ' Insert the HTML code to prompt for a password
    objIE.Document.Body.InnerHTML = "<DIV align=""center""><P>" & myPrompt _
                                  & "</P>" & vbCrLf _
                                  & "<P><INPUT TYPE=""password"" SIZE=""20"" " _
                                  & "ID=""Password""></P>" & vbCrLf _
                                  & "<P><INPUT TYPE=""hidden"" ID=""OK"" " _
                                  & "NAME=""OK"" VALUE=""0"">" _
                                  & "<INPUT TYPE=""submit"" VALUE="" OK "" " _
                                  & "OnClick=""VBScript:OK.Value=1""></P></DIV>"
    ' Make the window visible
    objIE.Visible = True
    ' Wait till the OK button has been clicked
    Do While objIE.Document.All.OK.Value = 0
        WScript.Sleep 200
    Loop
    ' Read the password from the dialog window
    GetPassword = objIE.Document.All.Password.Value
    ' Close and release the object
    objIE.Quit
    Set objIE = Nothing
End Function
'------------------------------------