'A utility to delete XP and Vista temp files directory.
'Put this file in Startup directory if you want.
'It will Delete Temp file at LogOn.
'Thanks to Bill James.
'www.billsway.com.

Option Explicit

Dim fso,ws,Title
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = WScript.CreateObject("WScript.Shell")
Title = "Temp File Cleaner"

Dim TmpDir : TmpDir = ws.Environment("Process")("Temp")

ChkTmpSafe

Dim OldTmpSize : OldTmpSize = fso.GetFolder(TmpDir).size

Dim arFiles(),cnt,dcnt,Fldr,SubFldr,File
cnt = -1
dcnt = 0
DelTmpFiles TmpDir

DelEmptyFldrs TmpDir

Dim strF,strD,RptSize,TotSave
CalcSave

If dcnt >= 1 Then ws.Popup cnt & strF & dcnt & _
  strD & vbCRLF & vbCRLF & RptSize & vbCRLF & _
  vbCRLF & TotSave,60,Title

Cleanup

Sub ChkTmpSafe
Dim Drv,Unsafe,WinDir,ComDir,PgmDir,SysDir,UnsafeDir
  If TmpDir = "" Then
    ws.Popup "Unsafe condition detected.  %TEMP% " &_
    "Variable is not set.",60,Title,16
    Cleanup
    WScript.Quit
  End If
  If Not fso.FolderExists(TmpDir) Then
    fso.CreateFolder(TmpDir)
    Cleanup
    WScript.Quit
  End If
  For Each Drv In fso.Drives
    'If a drive or partition is not formatted, an error occurs
    On Error Resume Next
    If Drv.DriveType = 2 or Drv.DriveType = 3 Then _
      UnSafe = UnSafe & Drv.RootFolder & "|"
    On Error GoTo 0
  Next
  Unsafe = Unsafe & fso.GetSpecialFolder(0) & "|"
  Unsafe = Unsafe & fso.GetSpecialFolder(0) & "\Command|"
  Unsafe = Unsafe & ws.RegRead("HKLM\Software\Microsoft" _
    & "\Windows\CurrentVersion\ProgramFilesPath") & "|"
  Unsafe = Unsafe & fso.getspecialfolder(1)
  Unsafe = Split(Unsafe,"|",-1,1)
  For Each UnsafeDir In Unsafe
    If UCase(UnsafeDir) = UCase(TmpDir) Or _
    UCase(UnsafeDir) & "\" = UCase(TmpDir) Or _
    UCase(UnsafeDir) = UCase(TmpDir) & "\" Then
      ws.Popup "Unsafe condition detected.  %TEMP% " &_
      "Variable is set to " & TmpDir,60,Title,16
      Cleanup
      WScript.Quit
    End If
  Next
End Sub

Sub DelTmpFiles(FldrSpec)
  Set Fldr = fso.GetFolder(FldrSpec)
  For Each File In Fldr.Files
    cnt = cnt + 1
    Redim Preserve arFiles(cnt)
    Set arFiles(cnt) = File
  Next
  For Each SubFldr in Fldr.SubFolders
    DelTmpFiles SubFldr
  Next
  For Each file in arFiles
    On Error Resume Next
    file.Delete True
    If Err.Number = 0 Then dcnt = dcnt + 1
    Err.Clear
  Next
End Sub

Sub DelEmptyFldrs(FldrSpec)
  Set Fldr = fso.GetFolder(FldrSpec)
  For Each SubFldr in Fldr.SubFolders
    DelEmptyFldrs SubFldr
  Next
  On Error Resume Next
  If UCase(Fldr.Path) <> UCase(TmpDir) Then
    If Fldr.Files.Count = 0 Then
      If Fldr.SubFolders.Count = 0 Then
        Fldr.Delete
      End If
    End If
  End If
  If Err.Number = 76 Then
    Err.Clear
    On Error GoTo 0
    DelEmptyFldrs(TmpDir)
  End If
End Sub

Sub CalcSave
  Dim NewTmpSize,SaveSize,s1,s2
  Dim TmpClnLog,OldSave,HideLog,Log
  NewTmpSize = fso.GetFolder(TmpDir).size
  SaveSize = OldTmpSize - NewTmpSize
  s1 = " free space reclaimed."
  If SaveSize < 1024 Then
    RptSize = SaveSize & " bytes" & s1
  ElseIf SaveSize < 1048576 Then
    RptSize = Round(SaveSize / 1024) & " KB" & s1
  Else RptSize = Round(SaveSize / 1048576) & " MB" & s1
  End If
  Log = fso.GetSpecialFolder(0) & "\TempClean.Log"
  If Not fso.FileExists(Log) Then fso.CreateTextFile(Log)
  If fso.GetFile(Log).Size = 0 Then
    Set TmpClnLog = fso.OpenTextFile(Log,8,True)
    TmpClnLog.WriteBlankLines(1)
  End If
  Set TmpClnLog = fso.OpenTextFile(Log,1)
  OldSave = TmpClnLog.ReadLine
  If Not IsNumeric(OldSave) Then OldSave = 0
  TotSave = OldSave + SaveSize
  Set TmpClnLog = fso.OpenTextFile(Log,2)
  TmpClnLog.WriteLine TotSave
  TmpClnLog.Close
  s2 = " reclaimed to date."
  If TotSave < 1024 Then
    TotSave = TotSave & " bytes" & s2
  ElseIf TotSave < 1048576 Then
    TotSave = Round(TotSave / 1024) & " KB" & s2
  Else TotSave = Round(TotSave / 1048576) & " MB" & s2
  End If
  cnt = cnt + 1
  If cnt = 1 Then strF = " file found, " _
    Else strF = " files found, "
  If dcnt = 1 Then strD = " file deleted." _
    Else strD = " files deleted." 
  Set TmpClnLog = Nothing
End Sub

Sub Cleanup
  Set fso = Nothing
  Set ws = Nothing
  Set Fldr = Nothing
End Sub