renee
Full Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
По мотивам скрипта SPV_Ed:
Код: On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strDateStart = Date ' Дата старта
strTimeStart = Time ' Время старта
aDate = split(strDateStart, ".")
nDays = 7 ' Количество дней для хранения суточных выгрузок
nWeeks = 4 ' Количество недель для хранения еженедельных выгрузок
nMonths = 6 ' Количество месяцев для хранения ежемесячных выгрузок
nYears = 5 ' Количество лет =ъ для хранения ежегодичных выгрузок
strDataPath = "F:\1cdb\" ' Путь к выгружаемой БД
strDataDailyFileName = "1c8-accounting_db_" & aDate(2) & "-" & aDate(1) & "-" & aDate(0) ' Шаблон имени создаваемой выгрузки (без расширения)
strPathArchiveLocal = "C:\backuper\tmp\" ' Локальный ресурс для хранения выгрузок
strPathArchiveRemote = "\\192.168.0.2\f$\backups\1c-dbs\" ' Сетевой ресурс для хранения выгрузок
strDirDaily = "daily\" ' Подпапка для хранение ежедневных выгрузок
strDirWeekly = "weekly\" ' Подпапка для хранение еженедельных выгрузок
strDirMonthly = "monthly\" ' Подпапка для хранение ежемесячных выгрузок
strDirYearly = "yearly\" ' Подпапка для хранение ежегодичных выгрузок
strLogFile = "C:\backuper\logs\" & strDataDailyFileName & ".log" ' Имя лог-файла скрипта (полное)
strArcErrLogFile = strPathArchiveLocal & strDataDailyFileName & "_1с.log" ' Имя лог-файла 1С (полное)
strPathToArchiver = "%ProgramFiles%\1cv81\bin\1cv8.exe" ' Путь до 1cv8.exe
strPathToBlat = "C:\backuper\blat262\full\blat.exe" ' Путь до blat.exe
strRecipientEmail = "email@server.com" ' e-mail, на который слать ошибочные логи скрипта
strSMTPUsr = "admin@server.com" ' SMTP пользователь
strSMTPPwd = "password" ' SMTP пароль
strSMTPSrv = "smtp.server.com" ' SMTP сервер
If objFSO.FolderExists(strPathArchiveLocal) = False Then
objFSO.CreateFolder(strPathArchiveLocal) ' Проверка путей
End If
If objFSO.FolderExists(strPathArchiveRemote) = False Then
objFSO.CreateFolder(strPathArchiveRemote) ' Проверка путей
End If
If objFSO.FolderExists(strPathArchiveRemote & strDirDaily) = False Then
objFSO.CreateFolder(strPathArchiveRemote & strDirDaily) ' Проверка путей
End If
If objFSO.FolderExists(strPathArchiveRemote & strDirWeekly) = False Then
objFSO.CreateFolder(strPathArchiveRemote & strDirWeekly) ' Проверка путей
End If
If objFSO.FolderExists(strPathArchiveRemote & strDirMonthly) = False Then
objFSO.CreateFolder(strPathArchiveRemote & strDirMonthly) ' Проверка путей
End If
If objFSO.FolderExists(strPathArchiveRemote & strDirYearly) = False Then
objFSO.CreateFolder(strPathArchiveRemote & strDirYearly) ' Проверка путей
End If
If objFSO.FileExists(strLogFile) = True Then
objFSO.DeleteFile(strLogFile) ' Проверка существования лога скрипта и его удаление (сегодняшнего)
End If
WriteTextFiles Now & " ==> СТАРТ СКРИПТА " & WScript.ScriptFullName, strLogFile
'================================================================================
' Завершение существующих терминальных сессий пользователей перед архивированием
'================================================================================
WriteTextFiles Now & " Завершение cуществующих терминальных сессий...", strLogFile
WshShell.Run "%comspec% /u /c chcp 1251 & quser >>" & strLogFile, 0, True
WshShell.Run "%comspec% /u /c chcp 1251 & for /f ""eol=; tokens=1 skip=2"" %i in ('quser') do qprocess %i >>" & strLogFile, 0, True
WshShell.Run "%comspec% /u /c chcp 1251 & for /f ""eol=; tokens=2 skip=1"" %i in ('quser') do if /i not ""%i""==""console"" logoff %i /v >>" & strLogFile, 0, True
WriteTextFiles Now & " Проверка наличия незавершившихся терминальных сессий...", strLogFile
WshShell.Run "%comspec% /u /c chcp 1251 & quser >>" & strLogFile, 0, True
'==========
' Выгрузка
'==========
WriteTextFiles Now & " Выгрузка: " & strDataPath & " ===> " & strPathArchiveLocal &_
strDataDailyFileName & ".dt", strLogFile
Set objFolder = objFSO.GetFolder(strDataPath)
WriteTextFiles Now & " Размер базы: " & Round(objFolder.Size / 1048576,2) & " Mb", strLogFile ' Вычисление размера базы
WshShell.Run chr(34) & strPathToArchiver & chr(34) &_
"CONFIG /F" & chr(34) & strDataPath & chr(34) & " /DumpIB" & chr(34) & strPathArchiveLocal &_
strDataDailyFileName & ".dt" & chr(34) & " /WA+ " & "/Out" & chr(34) & strArcErrLogFile &_
chr(34), 0, True ' Запуск выгрузки
If objFSO.FileExists(strPathArchiveLocal & strDataDailyFileName & ".dt") = True Then ' Вычисление размера выгрузки
Set objTestFile = objFSO.GetFile(strPathArchiveLocal & strDataDailyFileName & ".dt")
WriteTextFiles Now & " Размер выгрузки: " & Round(objTestFile.Size / 1048576,2) & " Mb", strLogFile
Else
WriteTextFiles Now & " ОШИБКА!!! ФАЙЛ: " & strPathArchiveLocal & strDataDailyFileName & ".dt" &_
" НЕ СОЗДАН!", strLogFile
objFSO.MoveFile strLogFile, strLogFile & ".err"
strResult = ReportIssueByMail (strLogFile & ".err")
WScript.Quit
End If
'==========================================
' Перемещение созданной выгрузки и лога 1С
'==========================================
strReturn = MoveNewArcFiles (strPathArchiveLocal & strDataDailyFileName & ".dt",_
strPathArchiveRemote & strDirDaily & strDataDailyFileName & ".dt") ' На сетевой ресурс в папку ежедневных выгрузок
strReturn = MoveNewArcFiles (strArcErrLogFile, strPathArchiveRemote & strDirDaily &_
strDataDailyFileName & "_1с.log") ' Лог 1С туда же
'=======================
' Рассовываем по папкам
'=======================
If (WeekDay(strDateStart, 2) = 1) And (Day(strDateStart) <> 1) Then
WriteTextFiles Now & " Перемещение в папку еженедельных выгрузок", strLogFile
strReturn = MoveNewArcFiles (strPathArchiveRemote & strDirDaily & strDataDailyFileName & ".dt",_
strPathArchiveRemote & strDirWeekly & strDataDailyFileName & ".dt")
strReturn = MoveNewArcFiles (strPathArchiveRemote & strDirDaily & strDataDailyFileName & "_1с.log",_
strPathArchiveRemote & strDirWeekly & strDataDailyFileName & "_1с.log") ' Если запущено в ПН (но не 1-го числа месяца), перемещаем в папку еженедельников
End If
If Day(strDateStart) = 1 Or _
((Day(strDateStart) = 2 Or Day(strDateStart) = 3) And (WeekDay(strDateStart, 2) = 6 Or _
WeekDay(strDateStart, 2) = 7)) Then
WriteTextFiles Now & " Перемещение в папку ежемесячных выгрузок", strLogFile
strReturn = MoveNewArcFiles (strPathArchiveRemote & strDirDaily & strDataDailyFileName & ".dt",_
strPathArchiveRemote & strDirMonthly & strDataDailyFileName & ".dt")
strReturn = MoveNewArcFiles (strPathArchiveRemote & strDirDaily & strDataDailyFileName & "_1с.log",_
strPathArchiveRemote & strDirMonthly & strDataDailyFileName & "_1с.log") ' Если запущено 1-го числа месяца (с учетом, попадало ли это на СБ или ВС), перемещаем в папку ежемесячников
End If
If Day(strDateStart) = 9 And Month(strDateStart) = 1 Then
WriteTextFiles Now & " Перемещение в папку ежегодичных выгрузок", strLogFile
strReturn = MoveNewArcFiles (strPathArchiveRemote & strDirDaily & strDataDailyFileName & ".dt",_
strPathArchiveRemote & strDirYearly & strDataDailyFileName & ".dt")
strReturn = MoveNewArcFiles (strPathArchiveRemote & strDirDaily & strDataDailyFileName & "_1с.log",_
strPathArchiveRemote & strDirYearly & strDataDailyFileName & "_1с.log") ' Если запущено 9-го января, перемещаем в папку ежегодичников
End If
'=========================================
' Удаляем неактуальные выгрузки и логи 1С
'=========================================
WriteTextFiles Now & " Удаление выгрузок старше " & nDays & " дней...", strLogFile
strReturn = DeleteOldFiles (nDays, strPathArchiveRemote & strDirDaily, "d") ' Удаление всех файлов (выгрузок и их логов 1С) старше nDays дней из папки ежедневных выгрузок
WriteTextFiles Now & " Удаление выгрузок старше " & nWeeks & " недель...", strLogFile
strReturn = DeleteOldFiles (nDays, strPathArchiveRemote & strDirWeekly, "ww") ' Удаление всех файлов (выгрузок и их логов 1С) старше nWeeks недель из папки еженедельных выгрузок
WriteTextFiles Now & " Удаление выгрузок старше " & nMonths & " месяцев...", strLogFile
strReturn = DeleteOldFiles (nDays, strPathArchiveRemote & strDirMonthly, "m") ' Удаление всех файлов (выгрузок и их логов 1С) старше nMonths месяцев из папки ежемесячных выгрузок
WriteTextFiles Now & " Удаление выгрузок старше " & nYears & " лет...", strLogFile
strReturn = DeleteOldFiles (nDays, strPathArchiveRemote & strDirYearly, "yyyy") ' Удаление всех файлов (выгрузок и их логов 1С) старше nYears лет из папки ежегодичных выгрузок
WriteTextFiles Now & " Операции окончены. Время выполнения: " & CDate(Time - strTimeStart), strLogFile
WriteTextFiles Now & " ==> ФИНИШ СКРИПТА " & WScript.ScriptFullName, strLogFile
'=============================
' Функция оповещения по почте
'=============================
Function ReportIssueByMail (strSource)
WshShell.Run chr(34) & strPathToBlat & chr(34) & strSource & " -to " & strRecipientEmail &_
" -serverSMTP " & strSMTPSrv & " -portSMTP 25 -u " & strSMTPUsr & " -pw " & strSMTPPwd &_
" -f " & strSMTPUsr, 0, True ' Отправка e-mail
End Function
'============================
' Функция перемещения файлов
'============================
Function MoveNewArcFiles (strPathSrc, strPathDst)
objFSO.MoveFile strPathSrc, strPathDst
If objFSO.FileExists(strPathDst) = True Then
WriteTextFiles Now & " Перемещено " & strPathSrc & " ===> " & strPathDst, strLogFile
Else WriteTextFiles Now & " ОШИБКА!!! НЕ ПЕРЕМЕЩЕНО: " & strPathSrc & " ===> " & strPathDst, strLogFile
End If
End Function
'======================================
' Функция удаления неактуальных файлов
'======================================
Function DeleteOldFiles (strPeriod, strPath, intrvl)
Set objFolder = objFSO.GetFolder(strPath)
Set objFiles = objFolder.Files
For Each File In objFiles
Result = Abs(DateDiff(intrvl, Now, File.DateCreated))
If Result > strPeriod-1 Then
File.Delete
If objFSO.FileExists(File.Path) = False Then
WriteTextFiles Now & " Удален файл: " & File.Path & " от: " & File.DateCreated
Else WriteTextFiles Now & " ОШИБКА!!! НЕ УДАЛЕНО: " & File.Path & " ОТ: " & File.DateCreated
End If
End If
Next
End Function
'===================================
' Процедура записи текстового файла
'===================================
Sub WriteTextFiles (strText, strPath)
Set objFile = objFSO.OpenTextFile(strPath, 8, True)
objFile.WriteLine(strText)
objFile.Close
End Sub
|
За основу взят именно скрипт SPV_Ed, хотя и очень существенно переработан.
Бэкапит базы 8-ки (файловой) выгрузками средствами самой 1с. Шлет на почту сбойный лог, если таковой есть. Для отправки почты нужна бесплатная консольная прога - blat. Как и в оригинале, рубит все терминальные соединения, делает ротацию бэкапов. Ротацию пока протестить не успел, но в текущее время работает отлично скрипт.
Добавлено:
Кстати, недолго думая можно прикрутить и абсолютно любые манипуляции с базой средствами 1с... И бэкап SQL в том числе. |
