一度空间

no intetion of cooling....

导航

对服务器上SQLServer数据进行备份和下载

Posted on 2008-01-20 21:37  liangyi_neil  阅读(406)  评论(0编辑  收藏  举报

动机

    虽然SqlServer可以远程注册和使用,但不能备份数据库到本地。为了能够在本地也用此数据库,需要将服务器上的数据库备份后下载到本地。
   
    对于有些服务器上并没有安装.net运行环境,所以采用了asp,对于有些服务器上没有安装office环境,采用了xml存储信息。


关键字:DreamWeaver,ASP,XML


设计过程
    1   IIS新建虚拟目录,Dreamweaver新建站点

    2   index.asp:
        <%Option Explicit%>  --是对asp变量的一种约束
        <!--#include file="conn.asp"-->  --引用conn.asp文件,#include使它不再是注释
        读取数据库名称:
        dim rs01
 set rs01 = server.CreateObject("adodb.recordset")
 rs01.open "select * from sysdatabases",objConn,1,1
        while not rs01.eof
            ***
            rs01.movenext
        wend
        rs01.close
        --select * from sysdatabases 是指取得所有数据库信息,其中name字段是数据库名称,前提是在master数据库下操作
        备份名称:
        function ChkDataBaseName(obj)
 {
  document.all("TxtBakName").value=obj.value + <%=year(date)%> + <%=month(date)%> + <%=day(date)%> + <%=hour(time)%> + <%=minute(time)%> + <%=second(time)%>;
 }
        --得到的是index.asp打开的时间,而不是真正现在的时间
        转到add.asp:
        function Add()
 {
  if(document.all("SelDataBase").value==""){alert('请选择数据库');return false;}
  document.form1.action="add.asp";
 }
        --action可以在form1属性里直接加上action="add.asp",但这样在做onClick="Add();"时遇到return false后仍然转到add.asp做相关操作,这会add.asp页面错误,所以在这里加上document.form1.action="add.asp";

    3   databasebakinfo.xml:
        <?xml version="1.0" encoding="gb2312"?>  --有的是encoding="UTF-8",我没发现现在用它们有什么区别
        <databasebaks>
            <databasebak>
                <bakname>PMKL200812010274</bakname>
                <baktime>2008-1-20 10:27:08</baktime>
                <bakip>127.0.0.1</bakip>
            </databasebak>
        </databasebaks>
        --一定要有最外的<databasebaks></databasebaks>一层

    4   databasebakinfo.xsl:
        将处理xml的方式都放到xsl很方便
        <xsl:template match="/databasebaks">
        </xsl:template>
        --处理databasebaks节点下的数据
        <xsl:for-each select="databasebak">
        </xsl:for-each>
        --循环处理databasebak节点下的数据
        <xsl:value-of select="position()"/>  --得到该节点(databasebak)的序号
        <xsl:value-of select="bakname"/>  --得到内容(bakname)

    5   funcxml.asp:
        FormatXml(strXmlFile, strXslFile)  --格式化XML文件,进行对xml和xsl文件进行load操作。返回必要的异常
        LoadXmlDoc(objXml, strLoad, blnIsStr, ByRef strErr)  --Load XML 文件

    6   clsDataBase.asp:  --基本操作类(相当于.net下的Model层与操作层)
        定义:
        Private m_intId               ' Id,对应databasebak节点在databasebaks集合中的位置
        Private m_bakname             ' 名称
        Private m_baktime             ' 时间
        Private m_bakip               ' ip
        Private m_strError            ' 出错信息
        类初始化:
        Private Sub Class_Initialize()
            m_strError = ""
            m_intId = -1
        End Sub
        类释放:
        Private Sub Class_Terminate()
            m_strError = ""
        End Sub
        读写各个属性:
        Public Property Get Id
            Id = m_intId
        End Property
 
        Public Property Let Id(intId)
            m_intId = intId
        End Property
 
        Public Property Get bakname
            bakname = m_bakname
        End Property
 
        Public Property Let bakname(strName)
            m_bakname = strName
        End Property
 
        Public Property Get baktime
            baktime = m_baktime
        End Property
 
        Public Property Let baktime(strBaktime)
            m_baktime = strBaktime
        End Property
 
        Public Property Get bakip
            bakip = m_bakip
        End Property
 
        Public Property Let bakip(strBakip)
            m_bakip = strBakip
        End Property
        获取错误信息:
        Public Function GetLastError()
            GetLastError = m_strError
        End Function
        --有时提示类型不匹配,暂没有用此函数
        私有方法,添加错误信息:
        Private Sub AddErr(strEcho)
            m_strError = m_strError + "<Div CLASS=""alert"">" & strEcho & "</Div>"
        End Sub
        --暂没有用此函数
        清除错误信息:
        Public Function ClearError()
            m_strError = ""
        End Function
        添加信息到XML文件:
        Public Function AddToXml(objXmlDoc)
            Dim objDataBase, objNode
   
            ClearError
   
            If objXmlDoc Is Nothing Then 
                AddToXml = False
                AddErr "Dom对象为空值"
                Exit Function
            End If
   
            ' 创建databasebak节点
            Set objDataBase = objXmlDoc.createElement("databasebak")
            objXmlDoc.documentElement.appendChild objDataBase
   
            ' 创建各个子节点
            '-----------------------------------------------------
            Set objNode = objXmlDoc.createElement("bakname") 
            objNode.Text = m_bakname
            objDataBase.appendChild objNode
   
            Set objNode = objXmlDoc.createElement("baktime")
            objNode.Text = m_baktime
            objDataBase.appendChild objNode
   
            Set objNode = objXmlDoc.createElement("bakip")
            objNode.Text = m_bakip
            objDataBase.appendChild objNode
   
            '-----------------------------------------------------
   
            Set objNode = Nothing
            Set objDataBase = Nothing
   
   
            On Error Resume Next
            objXmlDoc.save Server.MapPath("databasebakinfo.xml")          '保存XML文件
 
            If Err.Number = 0 Then
                AddToXml = True
  
            Else
 
                AddToXml = False
                AddErr Err.Description
            End If
        End Function
       
        从XML文件中删除数据:(需要首先设置Id)
        Public Function DeleteFromXml(objXmlDoc)
            Dim objNodeList, objNode
   
            ClearError
   
            If objXmlDoc Is Nothing Then
                DeleteFromXml = False
                AddErr "Dom对象为空值"
                Exit Function
            End If
   
            If CStr(m_intId) = "-1" Then
                DeleteFromXml = False
                AddErr "未正确设置联系人对象的ID属性"
                Exit Function
            End If
   
            Set objNodeList = objXmlDoc.getElementsByTagName("databasebak")   
            If objNodeList.length - m_intId < 0 Then
                DeleteFromXml = False
                AddErr "未找到相应的联系人"
                Set objNodeList = Nothing
                Exit Function
            End If
   
            On Error Resume Next
            Set objNode = objXmlDoc.documentElement.removeChild(objNodeList(id-1))
            If objNode Is Nothing Then
                DeleteFromXml = False
                AddErr "删除联系人失败"
                Set objNodeList = Nothing
                Exit Function
            Else
                objXmlDoc.save Server.MapPath("databasebakinfo.xml")
            End If
            Set objNode = Nothing
            Set objNodeList = Nothing
   
            If Err.Number = 0 Then
                DeleteFromXml = True
            Else
                DeleteFromXml = False
                AddErr Err.Description
            End If
        End Function
        --获得与修改函数不列出
   
    7   conn.asp:
        dim strConn,objConn
 strConn = "Driver={SQL Server};server=(local);uid=sa;pwd=sa;database=master;"
 set objConn = Server.CreateObject("ADODB.Connection")
 objConn.open strConn
 objConn.CursorLocation = 3

    8   add.asp:
        Dim objXml, objDataBase
 Dim strErr
 
 Set objXml = Server.CreateObject("MSXML2.DOMDocument")
 Set objDataBase = New Cls_DataBase          ' 生成Cls_DataBase对象
 
 If LoadXmlDoc(objXml, "databasebakinfo.xml", False, strErr) Then          ' 装载XML文件
     ' 给相应的属性赋值
     objDataBase.bakname = Request.Form("TxtBakName")
     objDataBase.baktime = date + time
     objDataBase.bakip = request.servervariables("remote_addr")
     If Not objDataBase.AddToXml(objXml) Then          ' 调用Cls_DataBase类的AddToXml方法,添加数据
         'AddErr strErr, objDataBase.GetLastError  --取消此错误提示
     else
  'AddErr strErr, "添加成功"
  --备份操作:
                dim rs02
  set rs02 = server.CreateObject("adodb.recordset")
  rs02.open "backup database "+ request.Form("SelDataBase") +" to disk ='d:\"+request.Form("TxtBakName")+".bak'",objConn,3,3
   
  set rs02=nothing
   
  response.Write("<script>alert('添加成功!')</script>")  --不知道为什么不显示,不知道被哪句影响了
  response.Redirect("index.asp")
     end if
 end if
 
 Set objXml = Nothing

    8   del.asp:
        Dim objXml, objDataBase, id
 Dim strErr
 id = request.QueryString("id")
  
 Set objXml = Server.CreateObject("MSXML2.DOMDocument")
 Set objDataBase = New Cls_DataBase          ' 生成Cls_DataBase对象
 
 If LoadXmlDoc(objXml, "databasebakinfo.xml", False, strErr) Then
     objDataBase.Id = id
     If Not objDataBase.DeleteFromXml(objXml) Then
   
     else
  response.Write id
  response.Write("<script language=javascript>this.location.href='index.asp';</script>")  --用location.href可以在返回时刷新页面
     end if  
 end if
 
 set objXml = nothing

    9   download.asp:
        Const USE_STREAM = 0 '0.不用流(Adodb.Stream)下载 1.用流下载
 Const ALLOW_FILE_EXT = "rar,zip,chm,doc,xls,swf,mp3,gif,jpg,jpeg,png,bmp,bak" '允许下载的文件的扩展名,防止源代码被下载
 
 Dim sDownFilePath '下载文件路径
 sDownFilePath = request.QueryString("id") + ".bak" '如果 sDownFilePath 为绝对路径,一定要将 sDownFilePath 转换为相对 本文件的相对路径
 
 Call DownloadFile(sDownFilePath)
 
 function DownloadFile(s_DownFilePath)
     '判断有没传递文件名
     If IsNull(s_DownFilePath) = True Or Trim(s_DownFilePath) = "" Then
  OutputErr "错误:先确定要下载的文件,下载失败"
     end if
  
 '判断扩展名是否合法
 Dim s_FileExt
 s_FileExt = Mid(s_DownFilePath, InstrRev(s_DownFilePath, ".")+1)
 If InStr("," & ALLOW_FILE_EXT & ",", "," & s_FileExt & ",") <= 0 Then
     OutputErr "错误:文件类型(" & s_FileExt & ")不允许被下载,下载失败"
 end if
  
 s_DownFilePath = Replace(s_DownFilePath, "", "/")
  
 '检测服务器是否支持fso
 Dim o_Fso
 On Error Resume Next
 Set o_Fso = Server.CreateObject("Scripting.FileSystemObject")
 If Err.Number <> 0 Then
     Err.Clear
     OutputErr "错误:服务器不支持fso组件,下载失败"
 end if
  
 '取得文件名,文件大小
 Dim s_FileMapPath
 Dim o_File, s_FileName, n_FileLength
 s_FileMapPath = Server.MapPath(s_DownFilePath)
 If (o_Fso.FileExists(s_FileMapPath)) = True Then
     Set o_File = o_Fso.GetFile(s_FileMapPath)
     s_FileName = o_File.Name
     n_FileLength = o_File.Size
     o_File.Close
 else
     OutputErr "错误:文件不存在,下载失败"
 end if
 Set o_Fso = Nothing
  
 '如果不是用流下载,直接转到该文件
 If USE_STREAM = 0 Then
     Response.Redirect sDownFilePath
     response.End()
 end if
  
 '检测服务器是否支持Adodb.Stream
 On Error Resume Next
 Set o_Stream = Server.CreateObject("Adodb.Stream")
     If Err.Number <> 0 Then
            Err.Clear
            OutputErr "错误:服务器不支持Adodb.Stream组件,下载失败"
     End If

     o_Stream.Tyep = 1
     o_Stream.Open
     o_Stream.LoadFromFile s_FileMapPath

 Response.Buffer = True
     Response.Clear
     Response.AddHeader "Content-Disposition", "attachment; filename=" & s_FileName
     Response.AddHeader "Content-Length", n_FileLength
     Response.CharSet = "UTF-8"
     Response.ContentType = "application/octet-stream"
     Response.BinaryWrite o_Stream.Read
 Response.Flush

     o_Stream.Close
     Set o_Stream = Nothing

 End Function

 Sub OutputErr(s_ErrMsg)
     Response.Write "<font color=red>" & s_ErrMsg & "</font>"
     Response.End
 End Sub


        对于删除部分,有时运行时删除失效,要重新进入该网站才可以,我还不知道为什么。