Скрипт написан на языке VBS. Используется на компьютерах, где пользователи не обладают достаточной квалификацией для архивирования и компьютеры не работают по ночам, когда можно было бы запускать архивацию. На практике использовалась на розничных точках в маленьких магазинах.
База архивируется обычным копированием, на лету. Скрипт нужно прописать в планировщик.
Продумана система разумного оставления некоторого количества предыдущих копий.
Параметры указываются в
DaysForStore – количество дневных архивов
ArcHEvery – с какой периодичностью запускать архивацию баз
IsCompessing – сжимать ли скопированный файл или оставлять как есть.
Скрипт нужно разместить в каталоге базы.
Скрипт создает архивы в подкаталоге ARC в каталоге рабочей базы.
Запуск скрипта нужно прописывать каждый час.
Скрипт проверяет, сколько времени прошло с момента последнего успешного бэкапа (по дате последнего архива) и сравнивает это значение с переменной DaysForStore.
Если нужно бэкапить, запускается копирование файла рабочей базы на лету в папку ARC.
Если установлен флаг IsCompessing, то файл сжимается в архив RAR, иначе просто переименовывается в RAR-файл без сжатия.
В имени архива указывается дата и время.
Чтобы не забивать диск архивами, проходит подчистка старых архивов. За текущий день архивы не чистятся, за предыдущие дни оставляется столько архивов, сколько дней указано в переменной DaysForStore.
Если в базе не работают пользователи на момент старта скрипта, он может заблокировать базу. Чтобы этого избежать, файл сначала открывается на чтение и только потом копируется. Это позволяет запустить копирование в разделенном режиме.
Возможность отключения архивации предусмотрена на слабых компьютерах, т.к. архивация там существенно тормозит работу самой 1с.
Скрипт разрабатывал по моему заданию и под моим контролем мой подчиненный, поэтому качество кода соответствующее, извиняюсь. Но работает, как часы.
На рисунке изображен пример работы скрипта для довольно больших баз 2 Гб.
'Версия от 20110913. Добавлено безопасное копирование, чтобы не блокировать базу.
'=== Блок настроек ===
DaysForStore7 = 7 'количество дней в неделе
ArcHEvery = 4 'промежуток времени через который нужно архивировать базу в часах
IsCompessing = false 'нужно ли архивировать (сжимать)
'=== КОД ===
'Чтобы не висело сообщение об ошибке при ошибках...
on error resume next
Set fso = CreateObject("Scripting.FileSystemObject")
PathToBase = fso.GetParentFolderName(WScript.ScriptFullName)
base = PathToBase & "1Cv8.1CD" 'получаю путь к файлу базы
PathToArcFolder = PathToBase & "arc" 'проверяю есть ли папка для архива
isExist = FSO.FolderExists(PathToArcFolder)
If isExist = False Then
Set PathToArc = FSO.CreateFolder(PathToArcFolder)
Else
End If
PathToArc = PathToArcFolder & ""
'проверяю нужно ли первый раз копировать и архивировать базу
NeedToBackup = False
'проверяю нужно ли копировать и архивировать базу
Set Folder = FSO.GetFolder(PathToArc) 'указываю путь к папке где у нас лежат архивы
FirstFile = True
For Each file In Folder.Files 'Возвращаемое значение: объект-коллекция "Files", содержащая все файлы данного каталога
maxdata = file.DateCreated 'получаю максимальную дату
If maxdata > Maximum Then
Maximum = maxdata
FirstFile = False
Else
End If
Next
theTime = DateDiff("h", Now, Maximum) * -1 ' разница времени
If theTime > ArcHEvery Then 'архивирую и копирую базу
NeedToBackup = True
ElseIf FirstFile = True Then
NeedToBackup = True
Else
End If
If NeedToBackup = True Then
'Если включен режим компрессии
if IsCompessing then
SafeCopyFile base, PathToArc ' копирую файл базы
set WshShell = WScript.CreateObject("WScript.Shell")
CommandLine = """C:Program FilesWinRARRar.exe"" a -ag -ibck -df -ri1:20 """ & PathToArc & "arc.rar"" """ & PathToArc & "1Cv8.1CD"""
'MsgBox CommandLine
Return = WshShell.Run(CommandLine) 'запуск архиватора и архивация
else
'Иначе просто копируем и переименовываем
DstFileName = "" & PathToArc & "" & "arc" & FormatDateYYYYMMDDHHMMSS(Now) & ".rar"
'MsbBox "" & DstFileName
SafeCopyFile base, DstFileName ' копирую файл базы
End If
Else
End If
'удаляю все лишние дневные архивы
If FirstFile = False Then
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(PathToArc) 'указываю путь к папке где у нас лежат архивы
For Each File In Folder.Files
nowday = DateSerial(Year(Now), Month(Now), Day(Now)) 'получил начало дня
datafist = DateValue(File.DateCreated) 'получаю файл с которым буду сравнивать последующие
If File.DateCreated < nowday Then 'сравниваю с началом дня
For Each file1 In Folder.Files '
datatwo = DateValue(file1.DateCreated) 'получаю вторую дату
If File.DateCreated <> file1.DateCreated Then
If datafist = datatwo Then
If File.DateCreated < file1.DateCreated Then 'если первый файл создан раньше вторго ,удаляем
File.Delete
Exit For 'выхожу из цикла
End If
Else
End If
Else
End If
Next
Else:
End If
Next
'удаляю все лишние недельные архивы
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(PathToArc) 'указываю путь к папке где у нас лежат архивы
For Each File In Folder.Files
wik = 0 'счетчик дней превышающие дату создания сравниваемого файла
wikfist = DateValue(File.DateCreated) 'получаю файл с которым буду сравнивать последующие
If wikfist <> nowday Then
For Each file1 In Folder.Files '
wiktwo = DateValue(file1.DateCreated) 'получаю вторую дату
If wiktwo <> nowday Then
If wikfist < wiktwo Then
wik = wik + 1
If wik >= DaysForStore7 Then 'если количество файлов больше 7 превышающие дату создания данного файла,удаляем
File.Delete
Exit For
Else
End If
Else
End If
Else
End If
Next
End If
Next
Else
End If
Sub SafeCopyFile(Src, Dst)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set File = FSO.GetFile(Src)
Set TextStream = File.OpenAsTextStream(1)
FSO.CopyFile Src, Dst, 1 ' копирую файл базы с заменой
TextStream.Close
End Sub
Function FormatDateYYYYMMDD(D)
FormatDateYYYYMMDD = Year(D) & Format2DigitString(Month(D)) & Format2DigitString(Day(D))
End Function
Function FormatDateYYYYMMDDHHMMSS(D)
FormatDateYYYYMMDDHHMMSS = FormatDateYYYYMMDD(D) & Format2DigitString(Hour(D)) & Format2DigitString(Minute(D)) & Format2DigitString(Second(D))
End Function
Function Format2DigitString(N)
If N >= 10 Then
Format2DigitString= Format2DigitString & N
Else
Format2DigitString= Format2DigitString & "0" & N
End If
End Function
Код
идентификатор