Книга знаний

Инф. технологии / Администрирование / Безопасность

Резервная копия с помощью WSH и VBS

Резервная копияАвтор статьи: DGorgoN | Редакторы:
Последняя редакция №4 от 02.03.09 | История
URL: http://kb.mista.ru/article.php?id=465

Ключевые слова: Резервная копия, Резервная копия 1С, Резервная копия баз 1С, WSH, VB script


Резервное копирование информации всегда было неотъемлемой частью жизни админа. Ошибки в программном обеспечении ОС и оборудования, отказы в работе систем хранения данных возникают рано или поздно в жизни любого предприятия (если оно не однодневка конечно).
Уберечь от данного форс-мажора может мой скрипт, который использует 2 точки для хранения данных. Считаю это обоснованным, т.к. места резервных копий должны быть разнесены в физически в разные точки, дабы уберечь, например, от молнии (что в мой практике было). Скрипт сначала копирует всю нужную информацию в 1-ю точку, потом делает архив во 2-ю точку.
Есть возможность ведения лога и отсылки его на электронную почту. Для использования функции отсылки лога на электронную почту используется бесплатный консольный почтовый клиент Zerat который с легкостью можно найти в интернете. Скрипт будет дополняться и улучшаться.

Внимание! Разработчик не несет ответственности за ваши несохраненные данные! Поэтому перед использованием прошу протестировать и ознакомится с текстом программы! Обо всех багах прошу писать в личку. Это Бэта версия!

Текст скрипта:

'Скрипт архивирования
InitialFolder = "C:\1Cbases" 'каталог, откуда копируем
TargetFolder = "\\Serv\AutoBuck" 'каталог, куда копируем
PackFolder = "\\Backup\AutoBuckUp" 'каталог, куда еще и архивируем
LogPath = "C:\Scripts" 'Куда будем складывать лог
LogCopyPath = "\\Backup\AutoBuckUp" 'Куда будем складывать копию лога
NetDiskName = "Y:" 'сетевой диск для подключения архивов
ArchName = "buh.rar" 'Имя архива для архивирования
SendBadFlagLogToMail = "youemail@mail.ru" 'Отправить сообщение на адреса об удачности завершения операции
SendGoodFlagLogToMail = "youemail@mail.ru" 'Отправить сообщение на адреса о неудачном завершения операции
IncludingLogToMail = 1 'Включать лог или нет
SMTPSenderPath = "C:\Scripts" 'Каталог Zerat

'===============================================Сам скрипт=================================================
'Если есть ошибки - продолжаем до следующего
On Error Resume Next
'Количество ошибок
Dim ErrNum
ErrNum = 0
'Создадим объект файловой системы
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Создадим объект - приложение
Set objShellApp = CreateObject("Shell.Application")
'Создадим объект файл для записи в него
Set LogStream = objFSO.OpenTextFile(LogPath & "\CopyLog.log", 8, True)
'Запишем начало Логирования
LogStream.WriteLine ""
LogStream.WriteLine "---------------------- Лог от: " & Now() & " ----------------------"
'Запишем начало копирования
LogStream.WriteLine "Начало копирования: " & Now()
'Назначим день недели автоматически
TargetFolder = TargetFolder & "\" & trim(Weekday(Date)-1)
LogStream.WriteLine "Номер дня недели копирования базы: " & trim(Weekday(Date)-1)
'Скопируем файлики
CopyFiles InitialFolder & "\"
'Если ошибки были
If Err.Number <> 0 Then
   'Если ошибка была, то
   ErrNum = ErrNum + 1
   LogStream.WriteLine
   LogStream.WriteLine InitialFolder & "\"
   LogStream.WriteLine Err.Description
   LogStream.WriteLine
   Err.Clear
End If
If ErrNum > 0 Then
   LogStream.WriteLine "Количество ошибок при копировании: " & Trim(ErrNum)
End If
'Запишим конец копирования
LogStream.WriteLine "Конец копирования: " & Now()

'Если есть ошибки - продолжаем до следующего
On Error Resume Next
LogStream.WriteLine "Начало архивирования: " & Now()

'Подключим сетевой диск
Dim WshNetwork 'переменная - содержащая доступ к диску
Dim flag 'переменная - указывающая на текущее подключение
Dim bitcode  'переменная - тип нажатой клавиши
'Определим, может диск уже подключен
Set WshNetwork = WScript.CreateObject("WScript.Network") ' переменная приводится к класу сетевых подключений
Set oDrives = WshNetwork.EnumNetworkDrives 'переменная - массив текущих дисковых подключений, где ячейка за ячейкой: имя диска и путь к нему в сети
flag=0 'первоачально
For i = 0 to oDrives.Count - 1 Step 2 ' просмотр всего массива дисковых состояний с шагом 2, для выделения только имен дисков
   if (oDrives.Item(i) =NetDiskName) then flag=1 ' если имя диска искомое ..
Next
if flag = 0 then ' если диск не подключен, то подключаем
   WshNetwork.MapNetworkDrive NetDiskName, PackFolder, false, "root", "password" ' Подключение сетевого диска
end if
'Если ошибки были
If Err.Number <> 0 Then
   'Если ошибка была, то
   ErrNum = ErrNum + 1
   LogStream.WriteLine
   LogStream.WriteLine NetDiskName & " - " & PackFolder
   LogStream.WriteLine Err.Description
   LogStream.WriteLine
   Err.Clear
End If

'Архивнем во временный архив
RunStr = "C:\Progra~1\WinRAR\WinRAR.exe a -m1 -r -y -dh " & NetDiskName & "\" & ArchName & " " & TargetFolder & "\"
Set WshShell = CreateObject("WScript.Shell")
ErrArch = WshShell.Run(RunStr, 1, True)
AcrhErrCopy = 0
'Если ошибки были
If Err.Number <> 0 Then
   'Если ошибка была, то
   ErrNum = ErrNum + 1
   AcrhErrCopy = 1
   LogStream.WriteLine
   LogStream.WriteLine "Ошибка архивирования " & Trim(ErrArch)
   LogStream.WriteLine Err.Description
   LogStream.WriteLine
   Err.Clear
End If
'Если есть ошибки - продолжаем до следующего
On Error Resume Next
'Удаляем старый архив
DelFile PackFolder & "\" & trim(Weekday(Date)-1) & "\" & ArchName
'Если ошибки были
If Err.Number <> 0 Then
   'Если ошибка была, то
   ErrNum = ErrNum + 1
   LogStream.WriteLine
   LogStream.WriteLine PackFolder & "\"
   LogStream.WriteLine Err.Description
   LogStream.WriteLine
   Err.Clear
End If
'Копирование файла
objFSO.CopyFile NetDiskName & "\" & ArchName, NetDiskName & "\" & trim(Weekday(Date)-1) & "\" & ArchName, True
LogStream.WriteLine "Номер дня недели копирования архива: " & trim(Weekday(Date)-1)
'Если есть ошибки - продолжаем до следующего
On Error Resume Next
'Если ошибки были
If Err.Number <> 0 Then
   'Если ошибка была, то
   ErrNum = ErrNum + 1
   AcrhErrCopy = 1
   LogStream.WriteLine
   LogStream.WriteLine PackFolder & "\"
   LogStream.WriteLine Err.Description
   LogStream.WriteLine
   Err.Clear
End If
'Если есть ошибки - продолжаем до следующего
On Error Resume Next
IF AcrhErrCopy = 0 then
   'Удаляем временый архив
   DelFile NetDiskName & "\" & ArchName
   'Если ошибки были
   If Err.Number <> 0 Then
       'Если ошибка была, то
       ErrNum = ErrNum + 1
       LogStream.WriteLine
       LogStream.WriteLine InitialFolder
       LogStream.WriteLine Err.Description
       LogStream.WriteLine
       Err.Clear
   End If
End If
LogStream.WriteLine "Конец архивирования: " & Now()

If IncludingLogToMail = 1 Then
   'Копирование файла лога
   objFSO.CopyFile LogPath & "\CopyLog.log", LogPath & "\CopyLog" & Year(date) & "-" & Month(date) & ".log", True
End If

If ErrNum > 0 Then
   LogStream.WriteLine "Количество ошибок: " & Trim(ErrNum)
   if Trim(SendBadFlagLogToMail) <> "" Then
       SendFlagToMail "Errors " & Trim(ErrNum), SendGoodFlagLogToMail, IncludingLogToMail, LogPath & "\CopyLog" & Year(date) & "-" & Month(date) & ".log"
   End If
Else
   LogStream.WriteLine "Ошибок нет"
   if Trim(SendGoodFlagLogToMail) <> "" Then
       SendFlagToMail "No errors ", SendGoodFlagLogToMail, IncludingLogToMail, LogPath & "\CopyLog" & Year(date) & "-" & Month(date) & ".log"
   End If
End If
LogStream.WriteLine "------------------- Конец лога от: " & Now() & " -------------------"

'Копирование файла лога
objFSO.CopyFile LogPath & "\CopyLog.log", LogCopyPath & "\CopyLog" & Year(date) & "-" & Month(date) & ".log", True

'Закроем все нафик
LogStream.Close

'========================================Сообщение об удачности завершения операции=================================================
'Процедура посылает короткое письмо на email, пользуясь почтовым клиентом zerat
Sub SendFlagToMail(TextMail, Addres, IncFlag, IncPath)

'Если есть ошибки - продолжаем до следующего
On Error Resume Next

'Удалим файл
DelFile SMTPSenderPath & "\sendtxt.txt"

'Создадим объект файл для записи в него
Set MsgSend = objFSO.OpenTextFile(SMTPSenderPath & "\sendtxt.txt", 8, True)

'Заполняем текст сообщения
MsgSend.WriteLine "Host:192.168.0.3"
MsgSend.WriteLine "From:Bot<bot@apksouz.ru>"
MsgSend.WriteLine "To:" & Trim(Addres)
MsgSend.WriteLine "Subject:Log message"
MsgSend.WriteLine "Type:multipart/mixed"
MsgSend.WriteLine "$boun"
MsgSend.WriteLine "Content-type: text/plain; charset=Windows-1251"
MsgSend.WriteLine "\n\n" & TextMail & " ,DT: " & Now()
MsgSend.WriteLine "--"
If IncFlag=1 then
   MsgSend.WriteLine "$incl " & IncPath
End If
MsgSend.Close

'Отправим сообщение
'Msgbox SMTPSenderPath & "\zerat.exe " & SMTPSenderPath & "\sendtxt.txt"
WshShell.Run SMTPSenderPath & "\zerat.exe " & SMTPSenderPath & "\sendtxt.txt", 1, True
LogStream.WriteLine "Сообщение было отправлено: " & Now()

End Sub


'===============================================Рекурсивное копирование=================================================
'Процедура рекурсивно перебирает файлы в каталоге
Sub CopyFiles(FolderPath)
   'Если есть ошибка - продолжим
   On Error Resume Next
   'Переберем файлики
   Set objFolderItems = objShellApp.NameSpace(FolderPath).Items()
   '
   For Each objFolderItem In objFolderItems
       'Если это папка
       If objFolderItem.IsFolder Then
           'Скопируем, вызвав процедуру
           CopyFiles objFolderItem.Path
           'Иначе
       Else
           'Создадим объект файл
           Set objFile = objFSO.GetFile(objFolderItem.Path)
           'Скопируем файлик
           CopyFile objFolderItem.Path
       End If
   Next
   If Err.Number <> 0 Then
       ' Если ошибка была, то
       ErrNum = ErrNum + 1
       LogStream.WriteLine
       LogStream.WriteLine FolderPath
       LogStream.WriteLine Err.Description
       LogStream.WriteLine
       Err.Clear
   End If
End Sub

'===============================================Копирование файла==============================================
Sub CopyFile(FilePath)
   'Если есть ошибка - продолжим
   On Error Resume Next
   '
   SubPath = Mid(FilePath, Len(InitialFolder) + 1)
   '
   TargetPath = TargetFolder & SubPath
   '
   FolderPath = objFSO.GetParentFolderName(TargetPath)
   '
   If Not objFSO.FolderExists(FolderPath) Then
       '
       CreateFolder FolderPath
   End If
   ' если у файла назначения есть атрибут ReadOnly, снимаем его, пока заремено
   'If objFSO.FileExists(TargetPath) Then
       '
   '    Set objFile = objFSO.GetFile(TargetPath)
       '
   '    If objFile.Attributes And 1 Then
           '
   '        objFile.Attributes = objFile.Attributes - 1
   '    End If
   'End If
   '
   objFSO.CopyFile FilePath, TargetPath, True
   '
   If Err.Number <> 0 Then
       ' Если ошибка была, то
       ErrNum = ErrNum + 1
       LogStream.WriteLine
       LogStream.WriteLine FilePath
       LogStream.WriteLine Err.Description
       LogStream.WriteLine
       Err.Clear
   Else
       'Если не было, то пишем какой файлик скопировали, пока заремено
       'LogStream.WriteLine FilePath
   End If
End Sub

'===============================================Создание каталога==============================================
Sub CreateFolder (FolderPath)
   'Если есть ошибка - продолжим
   On Error Resume Next
   ParentFolder = objFSO.GetParentFolderName(FolderPath)
   If Not objFSO.FolderExists(ParentFolder) Then
       CreateFolder ParentFolder
   End If
   objFSO.CreateFolder FolderPath
   If Err.Number <> 0 Then
       ' Если ошибка была, то
       ErrNum = ErrNum + 1
       LogStream.WriteLine
       LogStream.WriteLine FolderPath
       LogStream.WriteLine Err.Description
       LogStream.WriteLine
       Err.Clear
   Else
       'Если не было, то пишем какую папку скопировали, пока заремено
       'LogStream.WriteLine FolderPath
   End If
End Sub

'===============================================Удаление файла==============================================
Sub DelFile (FilePath)
   'Если есть ошибка - продолжим
   On Error Resume Next
   objFSO.DeleteFile FilePath, true
   If Err.Number <> 0 Then
       ' Если ошибка была, то
       ErrNum = ErrNum + 1
       LogStream.WriteLine
       LogStream.WriteLine FilePath
       LogStream.WriteLine Err.Description
       LogStream.WriteLine
       Err.Clear
   Else
       'Если не было, то пишем что удалили
       'LogStream.WriteLine "Удалим " & FilePath
   End If
End Sub

Страница скрипта: http://www.itdepartament.ru/index.php/archives/29
Закладка

Описание | Рубрикатор | Поиск | ТелепатБот | Захваченные статьи | Установки | Форум
© Станислав Митичкин (Волшебник), 2005-2021 | Mista.ru

Яндекс.Метрика