VBS CLEANUP SCRIPT FOR WINDOWS 7 /8 /10

Dear all;

I have been writing a little VBScript for System Cleanups;

It works with a small batch file which searches for OST files older than 365 days;

Enjoy & Use it wisely

Remember to test prior using!

OST.BAT FILECODE :

cd\
cd users
forfiles /s /m *.ost /d -365 /c "cmd /c del @path"


CLEANUP.VBS FILE CODE :

dim objWSH, sProfile, objFolder
dim objFSO, sProfileRoot, objProfileFolder
dim sWindows, sSysDrive, strDateToday, strUserTemp
dim OSType, strError, output
set objFSO=CreateObject("Scripting.FileSystemObject")
Set output = Wscript.stdout
Sub LogError (strError)
output.writeline Err.Number & " " & Err.Description & " " & strError
Err.Clear
End Sub
'' Function to get Space of C:\ Drive
Sub Disk_space()
Set objWMIService = GetObject("winmgmts:\\localhost\root\CIMV2")
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM Win32_LogicalDisk WHERE DeviceID = 'C:'",,48)
For Each objItem in colItems
Bytes = objItem.FreeSpace
If Bytes >= 1073741824 Then
SetBytes = Round(FormatNumber(Bytes / 1024 / 1024 / 1024, 2), 0) & " GB"
ElseIf Bytes >= 1048576 Then
SetBytes = Round(FormatNumber(Bytes / 1024 / 1024, 2), 0) & " MB"
ElseIf Bytes >= 1024 Then
SetBytes = Round(FormatNumber(Bytes / 1024, 2), 0) & " KB"
ElseIf Bytes < 1024 Then
SetBytes = Bytes & " Bytes"
Else
SetBytes = "0 Bytes"
End If
Wscript.Echo " " & SetBytes &" Free Space"
Next
End sub
Sub DeleteThisFolder(FolderName)
If FSO.FolderExists(FolderName) Then
objshell.Run "CMD.EXE /C RD /S /Q """ & FolderName & """",0,True
End If
end Sub
'function used for reading registry
Function ReadReg(RegPath)
Dim objRegistry, Key
Set objRegistry = CreateObject("Wscript.shell")
Key = objRegistry.RegRead(RegPath)
ReadReg = Key
Set objRegistry = Nothing
End Function
public sub DeleteFolderContents(strFolder)
' Deletes all files and folders within the given folder
dim objFolder, objFile, objSubFolder
on error resume next
set objFolder=objFSO.GetFolder(strFolder)
if Err.Number0 then
'call LogError (strFolder)
'Exit sub ' Couldn't get a handle to the folder, so can't do anything
end if
for each objSubFolder in objFolder.SubFolders
objSubFolder.Delete true
if Err.Number0 then
'Try recursive delete (ensures better result)
Err.Clear
DeleteFolderContents(strFolder & "\" & objSubFolder.Name)
'If Err Then Call LogError(strFolder & "\" & objSubFolder.Name)
end if
next
for each objFile in ObjFolder.Files
objFile.Delete true
'if Err.Number0 then Call LogError (objFile) ' In case we couldn't delete a file
next
end sub
'Clean Temp profile windows
Sub Clean_temp_windows ()
DeleteFolderContents("C:\Windows\Temp")
DeleteFolderContents ("C:\Windows\Logs\CBS")
DeleteFolderContents("C:\Windows\ServiceProfiles\LocalService\AppData\Local\Temp")
DeleteFolderContents("C:\Windows\ServiceProfiles\NetworkService\AppData\Local\Temp")
DeleteFolderContents("C:\Windows\System32\DriverStore\Temp")
DeleteFolderContents("C:\Windows\WinSxS\Temp")
DeleteFolderContents("C:\Windows\SoftwareDistribution")
end Sub
'Function to Clear profile (w7/8/10)
Sub Clean_profiles()
'Set profile
strUserTemp=userProfile & "\AppData\Local\Temp"
' Get user profile root folder
set objWSH = CreateObject("WScript.Shell")
sWindows = objWSH.ExpandEnvironmentStrings("%WINDIR%")
sSysDrive = objWSH.ExpandEnvironmentStrings("%SYSTEMDRIVE%")
sProfileRoot = ReadReg("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\ProfilesDirectory")
'output.writeline "Raw Registry Read Result: " & sProfileRoot
sProfileRoot = Replace (LCase(sProfileRoot), "%systemdrive%", sSysDrive)
'output.writeline "After Variable Replacement: " & sProfileRoot
set objWSH=nothing
set objProfileFolder=objFSO.GetFolder(sProfileRoot)
for each objFolder in objProfileFolder.SubFolders
''output.writeline "Processing profile: " & sProfileRoot & "\" & objFolder.Name & strUserTemp
sProfile=sProfileRoot & "\" & objFolder.Name
DeleteFolderContents sProfile & strUserTemp
''If Err Then Call LogError(sProfile)
next
end sub
'' Empty Recycle Bin
Sub E_recycle_bin
Const RECYCLE_BIN = &Ha&
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ObjShell = CreateObject("Shell.Application")
Set ObjFolder = ObjShell.Namespace(RECYCLE_BIN)
Set ObjFolderItem = ObjFolder.Self
Set colItems = ObjFolder.Items
For Each objItem in colItems
If (objItem.Type = "File folder") Then
FSO.DeleteFolder(objItem.Path)
Else
FSO.DeleteFile(objItem.Path)
End If
Next
end Sub
Public Function ClearIECache()
Dim objShell
Set objShell = CreateObject("WScript.Shell")
objShell.Run "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8"
objShell.Run "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 2"
objShell.Run "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 1"
'Temporary Internet Files - 8
'Cookies - 2
'History - 1
'Form Data - 16
'Passwords - 32
'Delete All - 255
'Delete All – “Also delete files and settings stored by add-ons” - 4351
Set objShell = Nothing
End Function
public Sub Cleanmgr ()
''set Keys for sagerun
Dim strKeyPath
Dim strComputer
Dim objReg
Dim arrSubKeys
Dim SubKey
Dim strValueName
Const HKLM=&H80000002
strKeyPath="SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\VolumeCaches"
strComputer="."
strValueName="StateFlags0001"
Set objReg=GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
objReg.Enumkey HKLM ,strKeyPath,arrSubKeys
For Each SubKey In arrSubKeys
objReg.SetDWORDValue HKLM,strKeyPath & "\" & SubKey,strValueName,2
Next
'' Launch Cleaner
Dim WshShell
Set WshShell=CreateObject("WScript.Shell")
WshShell.Run "C:\WINDOWS\SYSTEM32\cleanmgr /sagerun:1"
End Sub
Public Sub Clean_Chrome ()
strUserTemp=userProfile & "\Appdata\Local\Google\Chrome\User Data\Default\Cache"
' Get user profile root folder
set objWSH = CreateObject("WScript.Shell")
sWindows = objWSH.ExpandEnvironmentStrings("%WINDIR%")
sSysDrive = objWSH.ExpandEnvironmentStrings("%SYSTEMDRIVE%")
sProfileRoot = ReadReg("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\ProfilesDirectory")
'output.writeline "Raw Registry Read Result: " & sProfileRoot
sProfileRoot = Replace (LCase(sProfileRoot), "%systemdrive%", sSysDrive)
'output.writeline "After Variable Replacement: " & sProfileRoot
set objWSH=nothing
set objProfileFolder=objFSO.GetFolder(sProfileRoot)
for each objFolder in objProfileFolder.SubFolders
''output.writeline "Processing profile: " & sProfileRoot & "\" & objFolder.Name & strUserTemp
sProfile=sProfileRoot & "\" & objFolder.Name
DeleteFolderContents sProfile & strUserTemp
''If Err Then Call LogError(sProfile)
next
end sub
'' Calls shell function to clear the hibernate file
Public Sub Clear_hiberfil()
set objWSH = CreateObject("WScript.Shell")
objWSH.run "powercfg.exe /hibernate off"
end Sub
'' Function to go sleep in case you need it
Sub GoToSleep (iMinutes)
Dim Starting, Ending, t
Starting = Now
Ending = DateAdd("n",iMinutes,Starting)
Do
t = DateDiff("n",Now,Ending)
If t <= 0 Then Exit Do
WScript.Sleep 10000
Loop
End Sub
''Clean old OST calls batch file @Plinio engine ''
Sub Clean_OST()
set objWSH = CreateObject("WScript.Shell")
objWSH.run "ost.bat"
end Sub
''' MAIN SCRIPT ''
Clean_profiles()
Clean_temp_windows()
E_recycle_bin()
ClearIECache()
Cleanmgr()
Clean_Chrome()
Clear_hiberfil()
Disk_space()
Clean_OST()
Wscript.echo "Free Space After Cleanup ( Windows Cleanup Disktool results not included )"