' изменен 13.01.2011
' Орлов В.И. icq:5279603


On Error Resume Next

Dim dNow, FSO, str1, str2, str3, FileLog, i, intDays, strFldr, FldrBaza, PAthTo1C, cfg1c, PathToWinrar, User1c, Pass1c
Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject") 
dNow = now


' ================== SETUP BEGIN ===================================
   'логфайл
FileLog  = "\\ServerBD\d$\1c\BackUp.log"

   'Папка где хранить архивы
strFldr  = "\\ServerArch\d$\BackUp\1C"

   'Сервер|папка, где храняться базы данных 1С (общее начало пути до баз)
FldrBaza = "\\server\bases" 
   
   'Путь где лежит ехе-шник 1С
PathTo1C = "\\ServerBD\c$\Program Files\1Cv77\BIN\1cv7s.exe" 
   
   'Путь к файлу конфига архивации 1С
cfg1c    = "\\ServerBD\d$\1c\77.1c" 
   
   'Путь до программы WinRAR
PathToWinrar   = "\\ServerBD\c$\Program Files\WinRAR\Winrar.exe" 
   
   'Временный файл архива (удаляется после каждого архивирования)
TempRarDir = "\\ServerBD\d$\Backup"
TempRarFil = "Arxiv.zip"
TempRar  = TempRarDir & "\" & TempRarFil
   
   'За какое количество дней хранить архивы
intDays  = 10 

   'В каждой базе должен быть такой юзер
User1c   = "1C" '1C    
   
   'У юзера 1С в каждой базе должен быть такой пароль
Pass1c   = "gfhjkm" 'gfhjkm
' ================== SETUP END =====================================


Log("_________________  НАЧАЛО " & dNow)

dim test
test =        "   1 - " & PathExist("",FileLog)      & chr(9) & FileLog      & chr(13) & chr(10)
test = test & "   2 - " & PathExist(strFldr,"")      & chr(9) & strFldr      & chr(13) & chr(10)
'test = test & "  3 - " & PathExist(FldrBaza,"")     & chr(9) & FldrBaza     & chr(13) & chr(10)
test = test & "   4 - " & PathExist("",PathTo1C)     & chr(9) & PathTo1C     & chr(13) & chr(10)
test = test & "   5 - " & PathExist("",cfg1c)        & chr(9) & cfg1c        & chr(13) & chr(10)
test = test & "   6 - " & PathExist("",PathToWinrar) & chr(9) & PathToWinrar & chr(13) & chr(10)
test = test & "   7 - " & PathExist(TempRarDir,"")   & chr(9) & TempRarDir   & chr(13) & chr(10)
if InStr(test,"Ложь") or InStr(test,"False") then
   Log("!!! Работа скрипта """ & Wscript.ScriptFullName & """ прервана."  & chr(13) & chr(10) & test)
   TheEnd
end if   



' arhci <<"папка базы\">>, <<"Название базы">>
archi "market\Савёловский\Савёловский\",   "Савёловский"
archi "Buh_Meridian\",        "Бухгалтерия_Меридиан"
archi "dbprbasic\Салют\",       "ЗиК Салют"

DelOld strFldr, intDays

TheEnd  'КОНЕЦ 


function archi(baza, baza2)
   str1 = """" & PathTo1C & """ CONFIG /D""" & FldrBaza & "\" & baza & """ /N" & User1c & " /P" & Pass1c & " /@""" & cfg1c & """"
   if PathExist(FldrBaza & "\" & baza,"") = False then
      Log("!!! Архивация не завершена. Не айден путь:""" & FldrBaza & "\" & baza & """")
      exit function
   end if
   str2 = """" & PathToWinrar & """ a -ag+YYYY-MM-DD """ & strFldr & "\" & baza2 & """ """ & TempRar & """"
   if PathExist(strFldr, "") = False then
      Log("!!! Архивация не завершена. Не айден путь:""" & strFldr & """")
      exit function
   end if
   
   str3 = "cmd /C del """ & TempRar & """"
      Log(" " & Now & " BEGIN " & strFldr & "\" & year(dNow) & "-" & right("0" & month(dNow),2) & "-" & right("0" & day(dNow),2) & baza2 & ".rar")
   return = WshShell.Run(str1,0,True)
   dNow = now
   return = WshShell.Run(str2,0,True)
   return = WshShell.Run(str3,0,True)
   Set objFile = FSO.GetFile(strFldr & "\" & year(dNow) & "-" & right("0" & month(dNow),2) & "-" & right("0" & day(dNow),2) & baza2 & ".rar")
   Log(" " & Now & " END   Размер: " & round((objFile.Size/1024)/1024,2) & "Mb   " & baza2)
' пауза
      WScript.Sleep 5000 ' 1000 - 1 сек
End function

Sub log(sData)
    Dim ts, ForAppending
    ForAppending = 8
    PathExist "", FileLog
    Set ts = FSO.OpenTextFile(FileLog, ForAppending, True)
    ts.Write sData & chr(13) & chr(10)
    ts.Close
End Sub

Function DelOld(sFldr, iDays)
   Dim cF, oI, files
   files = ""
   Set cF = FSO.GetFolder(sFldr).Files
   For Each oI In cF
      If DateDiff("d", oI.DateLastModified, dNow) > iDays Then
         files = files & " " & round((oI.size/1024)/1024,2) & "Mb" & string(9-len(round((oI.size/1024)/1024,2) & "Mb")," ") & oI.Name & chr(13) & chr(10)
         oI.Delete
      End if
   Next
         if trim(files) <> "" then
            Log("!!! " & "Удалены файлы из папки " & sFldr & " до " & date - iDays & ":" & chr(13) & chr(10) & files)
         end if
End Function

Function PathExist(Dpath, Fpath)
PathExist = False
   if Dpath <> "" then
      if FSO.FolderExists(Dpath) = False then
         Log("!!! Папка НЕнайдена:""" & Dpath & """")
         PathExist = False
      else
         PathExist = True
      end if
   end if
   if Fpath <> "" then
      if FSO.FileExists(Fpath) = False then
         Log("!!! Файл НЕнайден:""" & Fpath & """")
         PathExist = False
      else
         PathExist = True
      end if
   end if
End function

Sub TheEnd()
Log("_________________  КОНЕЦ " & Now)
   Set WshShell = Nothing
   Set FSO = Nothing
   Set ts = Nothing
   Set cF = Nothing
   WScript.Quit 
End Sub