Скрипт архивации файловых баз 1c8 на лету

Скрипт написан на языке 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

 

 

Код

идентификатор

Скачать