VictorVG4 Таки в каком месте шерудить маню? Если
Цитата: бить полный архив, то потом разностный либо завершается по ошибке, либо делает полный бэкап, взависимости от указания имени (backup_full.7z.001, либо backup_full.7z). И т.п.
Скриптик
[more=вот он.]
Код: 'Ежедневное разностное резервное копирование данных при помощи 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
Для себя пакую, просто не уверен, что это другим интересно. 
