Резервное копирование MS SQL SERVER 2005 EXPRESS

Автор: ART-CODE
Прислал: Стриганов С.В. (ART-CODE) +7(916) 611-35-16

В MS SQL SERVER 2005 EXPRESS отсутствуют встроенные средства автоматизации резервного копирования.
Поэтому для создания Backup я написал хранимую процедуру и VBS скрипт.

Скрипт VBS вызывается из планировщика заданий Windows (он-же at.exe)
Пример командной строки для вызова скрипта:
C:\WINDOWS\system32\wscript.exe "D:\BACKUP\bcp_run.vbs"

Скрипт VBS проверяет наличие устаревших бекапов и удаляет их,
затем вызывает хранимую процедуру на сервере, которая "пробежавшись" по всем базам сервера создает для каждой базы отдельный файл *.bak,
затем скрипт VBS каждый из полученных файлов архивирует с помощью WinRar.exe и перекладывет в спец. папку для хранения.
Все действия записываются в лог-файл.

По-умолчанию:
- скрипт удаляет бекапы старше 15 календарных дней (переменная DelDiff)
- имя спец. папки для хранения = дата создания бекапа
- имя бекап-архива состоит из имени базы данных и времени архивирования, пароль на архив не установлен
- копирование архивов по сети не реализовано, желающие могут "прикрутить"


Хранимая процедура SWS_SRV_BCP (я ее создал в базе master)
Входной параметр @StrSaveDir - куда сохранять бекап
Выходной параметр - @CntBcp - сколько бекапов создано

CREATE	PROCEDURE [dbo].[SWS_SRV_BCP](
	@StrSaveDir  varchar(1000), @CntBcp int output
)AS
BEGIN

DECLARE @StrExec varchar(1000), @Namebase varchar(100), @NameBcp varchar(100)
set @CntBcp=0

DECLARE NamebasesCursor CURSOR FOR SELECT name from master.dbo.sysdatabases WHERE NAME NOT IN ('master', 'model', 'msdb', 'pubs', 'tempdb') --создаем курсор для имен баз из  sysdatabases 
OPEN NamebasesCursor --открываем курсор
WHILE 1=1 BEGIN --цикл 
FETCH  FROM  NamebasesCursor INTO @Namebase --получаем значение курсора в переменную

IF @@fetch_status=-1 begin --если дошли до конца 
BREAK --выход
end
IF @@fetch_status=-2 begin --если ошибка курсора
CONTINUE --продолжить
end

set @NameBcp=@Namebase+'_Backup'
set @StrExec=
'
USE master
EXEC sp_addumpdevice ''disk'', '''+@NameBcp+''', '''+@StrSaveDir+@Namebase+'.bak'' 
BACKUP DATABASE '+@Namebase+' TO '+@NameBcp+' 
exec sp_dropdevice '''+@NameBcp+'''
'
--print  @StrExec
EXEC(@StrExec)
set @CntBcp=@CntBcp+1
END -- конец цикла
DEALLOCATE NamebasesCursor

Return @CntBcp
END

'----------------------------------------------------------------------
' Стриганов С.В.  (ART-CODE)   +7(916) 611-35-16
' Скрипт резервного копирования SQL Server 2005 Express ( 06.11.20008 )
' работает совместно с хранимой процедурой на сервере
'----------------------------------------------------------------------
Dim fso, Sh, DelDiff , bcp_dir, conn_str, RAR' глобальные переменные и обьекты
Set fso  = CreateObject ("Scripting.FileSystemObject")
set Sh= CreateObject("WScript.Shell")
 
  DelDiff=15 ' удалять старые архивы , старше DelDiff дней
  bcp_dir="C:\BACKUP\"  ' каталог архивов (косая черта в конце обязательно !!!!)
  RAR="C:\PROGRA~1\WINRAR\rar.exe"
  conn_str="Provider=SQLNCLI.1; Password=xxx;Persist Security Info=True;User ID=sa;Initial Catalog=master;Data Source=127.0.0.1,1433;"

log (" --- start ---")
bcp_del  ' удаляем старые архивы
bcp_run  ' выполняем архивирование
log ("End") ' ну вот и все, закончили :)

Sh = noting 
fso = noting 
'----------------------------------------------------------------------
sub bcp_del()   ' удаляем старые архивы
Dim dirStart, folder
dirStart  = fso.GetFolder(bcp_dir) ' ищем в каталоге архивов старые папки с архивами
set folder = fso.GetFolder( dirStart )
DeleteOldDir(folder)  ' очистка каталога от старых 
end sub

'---------------------------------------------------------------------------                           
Sub DeleteOldDir( folder )     'обработка  директории - поиск и удаление старых папок с архивами
  ' все архивы разложены по папкам, а папки структурированы по датам - поэтому удаляем сразу всю папку..
    dim file, subfolder,d,diff , del
       
   del=0
   
   if (folder.Path&"\"<>bcp_dir) then  ' мы-же не будем удалять сам каталог для ведения архивов !!!       
           d = folder.DateCreated
        diff = DateDiff("d",d,Now) 
        
        if diff>DelDiff Then
        log ("Deleted: " & folder.Path)        
            folder.Delete 
            del=1
          end if 
                
   end if     
   if  del=0 then       
   For Each subfolder in folder.SubFolders ' конечно, мало вероятно что найдется вложенная подпапка, которая была создана реньше... но всеравно проверим
        DeleteOldDir( subfolder )
    Next
    end if       
    
End Sub

'---------------------------------------------------------------------------  
sub bcp_run()   ' выполняем архивирование
Dim  BcpCnt,folder,dirStart 

BcpCnt=SQL_BCP
log ("Bacup count: " & CStr(BcpCnt))
if BcpCnt>0 then  ' если хранимая процедура вернула количество созданных архивов больше 0
dirStart  = fso.GetFolder(bcp_dir) ' ищем в каталоге архивов файлы *.bak 
set folder = fso.GetFolder( dirStart )
BakToRar( folder )
end	if 
end sub

'-------------------------------------------------------------------------
Sub BakToRar( folder )     'обработка  директории - ищем ".bak", упаковываем в ".Rar"
dim file, subfolder,d,diff, NewBakFolder, StrRun, NewArcName

NewBakFolder = bcp_dir&fixed_len(Year(Date), 4) & "-"& fixed_len(Month(Date), 2) & "-"& fixed_len(Day(Date), 2)
if not fso.FolderExists(NewBakFolder) then
fso.CreateFolder(NewBakFolder)
end if
    
    For Each file in folder.Files
    if (InStr(file.Path, ".bak")<>0 ) then
    NewArcName=NewBakFolder & "\" & GetFileName(file.Path) & "_" & TimeNowAsFileName & ".rar "    
    StrRun="""" & RAR & """ " & " a -rr -c -ep -av- -idp -id -idc -inul " & NewArcName & " " & file.Path  
  
    'MsgBox StrRun   
    Sh.Run StrRun , 0, true
    log("Created: " &NewArcName)
    
    if  fso.FileExists(NewArcName) then 
    ' log("deleted: " &file.Path )
    fso.DeleteFile(file.Path)   
    end if     
        end if        
    next    
    
   For Each subfolder in folder.SubFolders ' конечно, мало вероятно что архив найдется во вложенной подпапке, но на всяк. случай оставлю эту обработку...
        
        if (subfolder.Path<>NewBakFolder) then 
         BakToRar( subfolder )
         end if         
    Next       
    
End Sub

'-------------------------------------------------------------------------
Function SQL_BCP () ' вызов хранимой процедуры на сервере, создающей файлы архива в указанном каталоге

Dim IntRetVal ' количество созданных архивов, будет возвращать эта функция
Dim c 
Dim prmStrSaveDir 
Dim prmCntBcp  ' количество созданных архивов, возвращает хранимая процедура 
Dim Cmd 

Set c = CreateObject("ADODB.Connection")
    c.Provider = "MSDASQL"
    c.CursorLocation = 3
    c.ConnectionString = conn_str
    c.Open 
    
Set prmStrSaveDir = CreateObject("ADODB.Parameter")
    prmStrSaveDir.Type = 200
    prmStrSaveDir.Size = 1000
    prmStrSaveDir.Direction = 1
    prmStrSaveDir.Value = bcp_dir
    prmStrSaveDir.Name = "@StrSaveDir"
    
Set prmCntBcp = CreateObject("ADODB.Parameter")
    prmCntBcp.Type = 3
    prmCntBcp.Direction = 2
    prmCntBcp.Name = "@CntBcp"

Set Cmd = CreateObject("ADODB.Command")

    Cmd.ActiveConnection = c
    Cmd.CommandText = "SWS_SRV_BCP" ' имя хранимой процедуры на сервере
    Cmd.CommandTimeout = 60000
    Cmd.CommandType = 4
    
    Cmd.Parameters.Append Cmd.CreateParameter("RETURN_VALUE", 3, 4)    

    Cmd.Parameters.Append prmStrSaveDir
    Cmd.Parameters.Append prmCntBcp

 Cmd.Execute
 
IntRetVal = prmCntBcp.Value

    Set prmStrSaveDir = Nothing  
    Set prmCntBcp = Nothing  
    Set Cmd = Nothing
    Set c = Nothing

SQL_BCP = IntRetVal
End Function

'-------------------------------------------------------------------------
Sub log(sData)  ' запись логов
    Dim ts, ForAppending
    ForAppending = 8
    Set ts = fso.OpenTextFile(bcp_dir&"backup.log", ForAppending, True)
    ts.Write Date & " - "& Time() & " " & sData & chr(13) & chr(10)
    ts.Close
End Sub

'-------------------------------------------------------------------------
Function fixed_len(i, l)
  fixed_len = String(l - Len(FormatNumber(i, 0, , , False)), "0") & FormatNumber(i, 0, , , False)
End Function

'-------------------------------------------------------------------------
Function TimeNowAsFileName()
Dim  s_time
  
s_time = fixed_len(Hour(Time), 2) & "_"& fixed_len(Minute(Time), 2)& "_" & fixed_len(Second(Time), 2)
TimeNowAsFileName=s_time
End Function

'-------------------------------------------------------------------------
Function GetFileName(strFilename)
Dim intPos, prmFileName
    intPos = InStrRev(strFilename, "\")
    prmFileName = Right(strFilename, Len(strFilename) - intPos)
    prmFileName=Replace(prmFileName, ".", "_")    
GetFileName=prmFileName
End Function