Colaboraciones en el Guille

Borrar temporales

[Script de Visual Basic que borra los archivos temporales]

 

Volver al artículo


'DeleteTempFiles.vbs - Utilidad para limpiar la carpeta temp en Win9x
'en el arranque. Ponga un acceso directo a este archivo en la carpeta Inicio.
'© Bill James - billjames.geo@yahoo.com - rev 04 Enero de 2000
'
'Autor Original- Michael Harris - posteado en el NG
'microsoft.public.scripting.vbs el 28 Agosto de 1999.
'
'Modificaciones introducidas por Bill James: Añadida una comprobación de 
'seguridad para evitar riesgos. Revisión del cuadro de diálogo final para 
'incluir el espacio recuperado en esta ejecución y el acumulativo hasta la fecha.
'
'Traducción de los comentarios y textos del cuadro de diálogo por Marcial Carlés.

Option Explicit

Dim fso,ws,Title
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = WScript.CreateObject("WScript.Shell")
Title = "Eliminar archivos temporales"

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 "Condición insegura detectada.  %TEMP% " &_
    "Variable no encontrada.",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 Drv.DriveType = 2 or Drv.DriveType = 3 Then _
      UnSafe = UnSafe & Drv.RootFolder & "|"
  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 "Condición insegura detectada.  %TEMP% " &_
      "Variable establecida a " & 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 = " de espacio libre recuperado."
  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 = " de espacio recuperado hasta la fecha."
  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 = " archivo encontrado, " _
    Else strF = " archivos encontrados, "
  If dcnt = 1 Then strD = " archivo borrado." _
    Else strD = " archivos borrados." 
  Set TmpClnLog = Nothing
End Sub

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

ir al índice principal del Guille