Tip: Удаляем файлы через vbScript (еще одна версия-Version 2)
Tag it:
Digg
Technorati
YahooMyWeb
Delicious
blogmarks
Среда, 12 Апрель 2006 | (11085)
Скрипт (vbscript), приведённый здесь, умеет удалять (delete) или переносить (move) файлы из указанной папки, основываясь на времени создания, удаления или последнего обращения. Создаёт лог (log) своей работы. Может оставить запись о результатах своей работы в журнале системы. Может ограничивать размер лога. Работает на нескольких серверах более полугода.

Содержимое VBScript:

'Автор: ДУбинин Александр. 2006 г.
'Записать в файл DelOldFiles.vbs и запустить. По умолчанию выводится подсказка для ключей и значения ключей по умолчанию.

'Примеры использования:
'Переместить файлы из папки "С:\SOMEWHERE" в папку "D:\SOMEWHERE" через 15 дней со дня последнего изменения или создания, записать в лог "C:\Scripts\DelOldFilesM.log", сделать запись в журнале системы, задать ограничение на размер лога в 1Мб
'cscript C:\Scripts\DelOldFiles.vbs С:\SOMEWHERE /tD:\SOMEWHERE /k15 /lC:\Scripts\DelOldFiles.log /oTrue /x1048576
'Удалить файлы из папки "D:\SOMEWHERE" через 46 дней со дня последнего изменения или создания, записать в лог "C:\Scripts\DelOldFilesD.log", сделать запись в журнале системы, задать ограничение на размер лога в 1Мб
'cscript C:\Scripts\DelOldFiles.vbs D:\SOMEWHERE /k46 /lC:\Scripts\DelOldFilesD.log /oTrue /x1048576

'Константы для процедуры записи событий в журнал событий ОС
const ev_SUCCESS = 0
const ev_ERROR = 1
const ev_WARNING = 2
const ev_INFORMATION = 4

'Константы для работы с файлами
const ForReading = 1
const ForWriting = 2
const ForAppending = 8

Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim ws: Set ws = CreateObject("WScript.Shell")
Dim PathToSearch, PathToMoveTo, DaysToKeep, WatchCreation, WatchModification, WatchAccess
Dim ForceFileDel, ForceFolderDel, FullLogPath, MaxLogSize, OutToEvLog

'PathToSearch 'папка, в которой будет производиться поиск устаревших файлов
PathToMoveTo = "" 'папка, в которую будут перемещаться устаревшие файлы
DaysToKeep = 0 'День со дня создания/изменения/обращения на который будет удалён файл
WatchCreation = True 'При сравнении даты файла учитывать дату создания
WatchModification = True 'При сравнении даты файла учитывать дату последнего изменения
WatchAccess = False 'При сравнении даты файла учитывать дату последнего обращения
ForceFileDel = True 'Удалять read-only файлы
ForceFolderDel = False 'Удалять read-only папки
FullLogPath = "" 'Подробный лог. Если "", то не использовать
MaxLogSize = 512000 'Максимальный размер подробного лога в байтах. Старые записи стираются
OutToEvLog = False 'Выводить диагностические сообщения в журнал системы вместо консоли

Dim FileCount, DFileCount, FolderCount, DFolderCount
Dim OldFolderSize, NewFolderSize, Summury
FileCount = 0 'Количество обработанных файлов
DFileCount = 0 'Количество удалённых файлов
FolderCount = 1 'Количество обработанных папок
DFolderCount = 0 'Количество удалённых папок

CheckConditions
OldFolderSize = fso.GetFolder(PathToSearch).Size
WriteToLog "Запуск скрипта " & WScript.ScriptFullName
DelOldFiles fso.GetFolder(PathToSearch)
NewFolderSize = fso.GetFolder(PathToSearch).Size
SpaceCleared = OldFolderSize - NewFolderSize
Summury = "Завершение работы скрипта " & vbNewLine & _
          "Папка: " & PathToSearch & vbNewLine & _
          "Обработано файлов: " & FileCount & vbNewLine & _
          "Удалено/перемещено файлов: " & DFileCount & vbNewLine & _
          "Обработано папок: " & FolderCount & vbNewLine & _
          "Удалено папок: " & DFolderCount & vbNewLine & _
          "Размер до удаления: " & OldFolderSize & vbNewLine & _
          "Размер после удаления: " & NewFolderSize & vbNewLine & _
          "Освобождено места: " & SpaceCleared
If OutToEvLog Then WriteToLog Summury
WriteToEventLog ev_INFORMATION, Summury
CheckLogFileSize

Function DelOldFiles(Folder)
  Dim FileList, FolderList, f, s, strMoveTo, i, p

  Set FileList = Folder.Files 'Список файлов в папке
  For Each f  In FileList 'Обрабатываем все файлы в папке.
    FileCount = FileCount + 1
    If DateDifference(f) >= DaysToKeep Then
      On Error Resume Next
      If PathToMoveTo = "" Then
        s = "Удаление файла " & f.Path & " " & CHR(9)
        f.Delete(ForceFileDel)
      Else
        strMoveTo = PathToMoveTo & Right(f.ParentFolder.Path, Len(f.ParentFolder.Path) - Len(PathToSearch)) & "\"
        If not fso.FolderExists(strMoveTo) Then
          FolderList = Split(strMoveTo, "\")
          p = FolderList(0)
          For i = 1 to UBound(FolderList)
            p = p & "\" & FolderList(i)
            If not fso.FolderExists(p) Then fso.CreateFolder(p)
            If Err.Number <> 0 then Exit For
          Next
        End If
        If Err.Number = 0 then
          s = "Перемещение файла " & f.Path & " в " & strMoveTo & CHR(9)
          f.Move(strMoveTo)
        Else
          s = "Создание папки " & p & " " & CHR(9)
        End If
      End If
      If Err.Number <> 0 then
        s = s & Err.Description
        Err.Clear
      Else
        s = s + "OK"
        DFileCount = DFileCount + 1
      End If
      On Error GoTo 0
      WriteToLog s
    End If
  Next

  Set FolderList = Folder.SubFolders 'Список подпапок
  For Each f  In FolderList 'Обходим все подпапки в папке.
    FolderCount = FolderCount + 1
    DelOldFiles(f)
    If (f.Files.Count = 0) and (f.SubFolders.Count = 0) Then
      On Error Resume Next
      s = "Удаление папки " & f.Path & " " & CHR(9)
      f.Delete(ForceFolderDel)
      If Err.Number <> 0 then
        s = s + Err.Description
        Err.Clear
      Else
        s = s + "OK"
        DFolderCount = DFolderCount + 1
      End If
      On Error GoTo 0
      WriteToLog s
    End If
  Next
End Function

Function DateDifference(File)
  Dim Diff, TmpDiff
  If WatchCreation Then
    Diff = DateDiff("d", File.DateCreated, Now)
  End If
  If WatchModification Then
    TmpDiff = DateDiff("d", File.DateLastModified, Now)
    If (TmpDiff < Diff) or not WatchCreation Then Diff = TmpDiff
  End If
  If WatchAccess Then
    TmpDiff = DateDiff("d", File.DateLastAccessed, Now)
    If (TmpDiff < Diff) or not WatchCreation or not WatchModification Then Diff = TmpDiff
  End If
  DateDifference = Diff
End Function

Sub CheckConditions
  dim i, s, sLen, strKey, strValue, strErrors
  Set Args = WScript.Arguments
  If Args.Count < 1 then ShowHelp
  strErrors = ""
  PathToSearch = Args(0)
  For i = 1 to Args.Count - 1
    s = Args(i)
    sLen = Len(s)
    strKey = Left(s, 2)
    If sLen > 1 Then strValue = Right(s, Len(s) - 2)
    On Error Resume Next
    If strValue = "" Then Err.Raise vbObjectError + 2, "Наличие значения обязательно. Неправильно указан параметр"
    Select Case strKey
      Case "/t" PathToMoveTo = strValue
      Case "/k" DaysToKeep = CLng(strValue)
      Case "/c" WatchCreation = CBool(strValue)
      Case "/m" WatchModification = CBool(strValue)
      Case "/a" WatchAccess = CBool(strValue)
      Case "/f" ForceFileDel = CBool(strValue)
      Case "/d" ForceFolderDel = CBool(strValue)
      Case "/l" FullLogPath = strValue
      Case "/x" MaxLogSize = CLng(strValue)
      Case "/o" OutToEvLog = CBool(strValue)
      Case Else
        Err.Raise vbObjectError + 1, WScript.ScriptFullName, "Ошибка в параметрах командной строки"
    End Select
    If Err.Number <> 0 Then
      If strErrors <> "" Then strErrors = strErrors & vbNewLine
      strErrors = strErrors & Err.Description & ": " & s
      Err.Clear
    End If
    On Error Goto 0
  Next

  If strErrors<>"" Then
    WriteToEventLog ev_ERROR, strErrors
    Wscript.Quit
  End If

  If Not (WatchCreation or WatchModification or WatchAccess) Then
    WriteToEventLog ev_ERROR, "Не выбрано ни одного условия сравнения файлов (WatchCreation, WatchModification, WatchAccess)."
    Wscript.Quit
  End If
End Sub

Sub WriteToEventLog(intType, strMessage)
  Dim s
  s = WScript.Name & " (" & WScript.ScriptFullName & "):" & vbNewLine & strMessage
  If OutToEvLog Then
    ws.LogEvent intType, s
  Else
    WScript.Echo s
  End If
End Sub

Sub WriteToLog(strMessage)
  Dim logfile
  If FullLogPath = "" Then Exit Sub
  On Error Resume Next
  Set logfile = fso.OpenTextFile(FullLogPath, ForAppending, True, TristateFalse)
  if Err.Number <> 0 Then
    WriteToEventLog ev_WARNING, "При открытии файла лога " & FullLogPath & _
                                " возникла ошибка: " & Err.Description
    FullLogPath = ""
    Exit Sub
  End If
  logfile.WriteLine CustomNow & strMessage
  if Err.Number <> 0 Then
    WriteToEventLog ev_WARNING, "При записи в файл лога " & FullLogPath & _
                                " возникла ошибка: " & Err.Description
    FullLogPath = ""
    Exit Sub
  End If
  On Error GoTo 0
  logfile.Close
End Sub

'Выдаёт дату-время в виде "YY-MM-DD HH:MM:SS "
Function CustomNow
  dim d : d = Now
  CustomNow = N2S(Year(d)) & "-" & N2S(Month(d)) & "-" & N2S(Day(d)) & _
    " " & N2S(Hour(d)) & ":" & N2S(Minute(d)) & ":" & N2S(Second(d)) & " "
End Function

Function N2S(Number)
  dim s
  s = CStr(Number)
  If Len(s) = 1 Then s = "0" + s
  If Len(s) > 2 Then s = Right(s, 2)
  N2S = s
End Function

Sub CheckLogFileSize
  Dim f, FileSize, strContents, PosToCut
  Set f = fso.GetFile(FullLogPath)
  If f.Size <= MaxLogSize Then exit Sub
  FileSize = f.Size
  Set f = fso.OpenTextFile(FullLogPath, ForReading, True)
  strContents = f.ReadAll
  f.Close
  PosToCut = InStr(FileSize - MaxLogSize, strContents, vbNewLine)
  strContents = Right(strContents, FileSize - PosToCut - 1)
  Set f = fso.OpenTextFile(FullLogPath, ForWriting, True)
  f.Write strContents
  f.Close
End Sub

Sub ShowHelp
  WScript.Echo "Usage: " & WScript.ScriptFullName & " <Путь> [<Ключи>]" & vbNewLine & _
    "<Путь> - Папка, в которой будет производиться поиск устаревших файлов" & vbNewLine & _
    "Ключи:" & vbNewLine & _
    "/t<PathToMoveTo> - Папка, в которую устаревшие файлы будут перемещаться вместо удаления(по умолчанию:" & PathToMoveTo & ")" & vbNewLine & _
    "/k<DaysToKeep> - День со дня создания/изменения/обращения на который будет удалён файл (по умолчанию:" & CStr(DaysToKeep) & ")" & vbNewLine & _
    "/c<Value> - При сравнении даты файла учитывать дату создания (по умолчанию:" & WatchCreation & ")" & vbNewLine & _
    "/m<Value> - При сравнении даты файла учитывать дату последнего изменения (по умолчанию:" & WatchModification & ")" & vbNewLine & _
    "/a<Value> - При сравнении даты файла учитывать дату последнего обращения (по умолчанию:" & WatchAccess & ")" & vbNewLine & _
    "/f<Value> - Удалять файлы с атрибутом ""только для чтения"" (по умолчанию:" & ForceFileDel & ")" & vbNewLine & _
    "/d<Value> - Удалять папки с атрибутом ""только для чтения"" (по умолчанию:" & ForceFolderDel & ")" & vbNewLine & _
    "/l<FullLogPath> - Файл для записи подробного журнала" & vbNewLine & _
    "/x<MaxLogSize> - Максимальный размер подробного журнала в байтах. Старые записи стираются (по умолчанию:" & CStr(MaxLogSize) & ")" & vbNewLine & _
    "/o<Value> - Выводить диагностические сообщения в журнал системы вместо консоли (по умолчанию:" & CStr(OutToEvLog) & ")" & vbNewLine & _
    "Логические значения могут быть указаны как 0|1, True|False"
  WScript.Quit
End Sub



Вы можете скчать этот скрипт в текстовом формате, только не забудьте переименовать файл, что бы у него было расширение VBS.

Скачать