动机
虽然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
对于删除部分，有时运行时删除失效，要重新进入该网站才可以，我还不知道为什么。
