Резервная копия с помощью WSH и VBS
Ключевые слова: Резервная копия, Резервная копия 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
|