'Ежедневное разностное резервное копирование данных при помощи 7-Zip и VBScript (28.08.2009) 'http://zheleznov.info/backup_diff.htm '== НАСТРОЙКИ 'что копировать? 'Const SRC = """C:\Users\*""" 'каталог и маска для резервирования 'Const SRC = """%AppData%\Opera\Opera\*""" 'здесь допускаются переменные окружения Const SRC = "@C:\files.txt" 'взять список каталогов из текстового файла 'куда копировать? Const PREFIX = "backup" 'префикс имени архива, условное название архивируемого ресурса Const EXT = ".7z" 'расширение архивного файла Const HISTORY = 4 'количество полных архивов в истории 'чем упаковывать? Function ReadAllTextFile Const ForReading = 1, ForWriting = 2 Dim fso, f Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.OpenTextFile("C:\run", ForReading) ReadAllTextFile = f.ReadAll End Function Const PROGRAM = """%ProgramFiles%\7-Zip\7z.exe""" 'если 7-Zip установлен 'Const PROGRAM = "7z.exe" 'если архиватор лежит рядом со скриптом Const OPTIONS = "-mhe -spf -slp -r -mx5 -x@C:\exclude.txt -v2240m" 'опции архиватора 'где отмечать? Const REPORT = "report.txt" 'файл журнала 'не завершать скрипт аварийно On Error Resume Next '== ОБЩИЕ ОПРЕДЕЛЕНИЯ 'записать сообщение в журнал Sub Log(msg) Const APPEND = 8 'добавить в конец файла Dim fso, f Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.OpenTextFile(REPORT, APPEND, True) f.WriteLine Now & " " & msg f.Close End Sub 'объект для работы с файлами Dim fso Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim full 'имя последнего полного архива '== СОЗДАНИЕ АРХИВА 'выбрать способ архивации Dim arg, cmd cmd = "" 'команда архиватора Set arg = WScript.Arguments If arg.Count > 0 Then If arg.Item(0) = "diff" Then cmd = "u" ElseIf arg.Item(0) = "full" Then cmd = "a" Else cmd = "" End If End If 'полный архив If cmd = "a" Then 'имя нового архива full = PREFIX & "-" & FormatDateTime(Date, vbShortDate) & "-full" & EXT 'если сегодня архив уже делали - не продолжать If (fso.FileExists(full)) Then Log full & ": создан РАНЕЕ и не будет перезаписан" WScript.Quit End If 'опции командной строки opt = OPTIONS 'разностный архив ElseIf cmd = "u" Then 'найти полный архив Dim dir, fc, f, last Set dir = fso.GetFolder(".") 'рабочий каталог Set fc = dir.Files 'коллекция файлов full = "" last = 0 'дата последнего полного архива For Each f In fc If Left(f.name, Len(PREFIX & "-")) = PREFIX & "-" _ And Right(f.name, Len("-full" & EXT)) = "-full" & EXT _ And f.DateLastModified > last Then full = f.name last = f.DateLastModified End If Next 'без полного архива не продолжать If Len(full) = 0 Then Log "ОШИБКА! Полный архив НЕ НАЙДЕН, разностный архив не может быть создан" WScript.Quit End If 'имя нового архива diff = Left(full, Len(full) - Len("full" & EXT)) & FormatDateTime(Date, vbShortDate) & EXT 'если сегодня архив уже делали - не продолжать If (fso.FileExists(diff)) Then Log diff & ": создан РАНЕЕ и не будет перезаписан" WScript.Quit End If 'опции командной строки opt = OPTIONS & " -u- -up0q3x2z0!" & diff 'справка Else WScript.Echo "Ежедневное разностное резервное копирование:" & vbCrLf _ & SRC & vbCrLf _ & vbCrLf _ & "Отчет в файле:" & vbCrLf _ & REPORT & vbCrLf _ & vbCrLf _ & "Опции командной строки:" & vbCrLf _ & "full - создание полного архива" & vbCrLf _ & "diff - создание разностного архива" WScript.Quit End If 'если нет файла со списком исключений exclude.txt - создать 'файл указан в опциях архиватора и поэтому должен существовать, хотя бы пустой If Not fso.FileExists("C:\exclude.txt") Then Dim tf Set tf = fso.CreateTextFile("C:\exclude.txt") tf.Close End If 'создать архив Dim sho, ret Set sho = WScript.CreateObject("WSCript.Shell") ret = sho.Run(PROGRAM & " " & cmd & " " & full & " " & "-p" & ReadAllTextFile & " " & opt & " " & SRC, 7, True) '7 = в свернутом виде 'результат Dim msg Select Case ret Case 0 msg = "Ok" Case 1 msg = "Некоторые файлы были ЗАНЯТЫ и поэтому не добавлены в архив" Case 2 msg = "ОШИБКА при создании архива" Case 7 msg = "ОШИБКА в командной строке" Case 8 msg = "ОШИБКА - недостаточно памяти" Case 255 msg = "ОШИБКА - создание архива было ПРЕРВАНО пользователем" Case Else msg = "ОШИБКА при создании архива, код " & ret End Select If cmd = "a" Then Log full & ": " & msg Else Log diff & ": " & msg End If '== УДАЛЕНИЕ УСТАРЕВШИХ АРХИВОВ 'составить массивы имен и дат имеющихся ПОЛНЫХ архивов 'дата берется из файловой системы, а не из имени файла :( Dim i, names(), dates() ReDim names(0) ReDim dates(0) Set dir = fso.GetFolder(".") 'рабочий каталог Set fc = dir.Files 'коллекция файлов i = 0 For Each f in fc If Left(f.name, Len(PREFIX & "-")) = PREFIX & "-" _ And Right(f.name, Len("-full" & EXT)) = "-full" & EXT Then ReDim Preserve names(i + 1) ReDim Preserve dates(i + 1) names(i) = f.name dates(i) = f.DateLastModified i = i + 1 End If Next 'отобрать последние ПОЛНЫЕ архивы Dim j, dmax, imax For j = 1 To HISTORY dmax = 0 For i = 0 To UBound(dates) If dates(i) > dmax Then dmax = dates(i) imax = i End If Next dates(imax) = 0 names(imax) = "" Next 'удалить устаревшие ПОЛНЫЕ архивы и соответствующие разностные Dim pref For i = 0 To UBound(names) If Len(names(i)) > 0 Then Log names(i) & ": устарел, должен быть УДАЛЕН" fso.DeleteFile names(i), False 'файлы с атрибутом ReadOnly не удаляются! 'соответствующие разностные pref = Left(names(i), Len(names(i)) - Len("full" & EXT)) For Each f in fc If Left(f.name, Len(pref)) = pref _ And Right(f.name, Len(EXT)) = EXT Then Log f.name & ": устарел, должен быть УДАЛЕН" fso.DeleteFile f.name, False 'файлы с атрибутом ReadOnly не удаляются! End If Next End If Next |