www.gusucode.com > 艺术签名文章资讯网源代码 > 艺术签名文章资讯网源代码/624/adminhtry/admin_loadskin.asp

    <!--#include file="setup.asp"-->
<!--#include file="check.asp"-->
<%
Dim mdbname, sConn, i
Dim Action
Set Rs = Server.CreateObject("ADODB.Recordset")
Admin_header
Response.Write "<table border=""0"" cellspacing=""1"" cellpadding=""5"" align=center width=""95%"" class=""tableBorder"">" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<th><a href=? Class=showtitle>模版导出功能</a> | <a href=?action=load Class=showtitle>模版导入功能</a></th>" & vbCrLf
Response.Write "</tr>" & vbCrLf
Response.Write "<tr>" & vbCrLf
Response.Write "<td Class=TableRow1>" & vbCrLf
Response.Write "注意<br>" & vbCrLf
Response.Write "1,确认模版数据库名正确;<br>" & vbCrLf
Response.Write "2,如模版数据库放在skin目录下,即填写:"& Newasp.InstallDir &"skin/NC_Skin.mdb;<br>" & vbCrLf
Response.Write "3,模版数据库内备份的表名为NC_Template,请不要更改;<br>" & vbCrLf
Response.Write "4,模版数据包括CSS设置,与及所有界面设置." & vbCrLf
Response.Write "</td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
Response.Write "</table><br>" & vbCrLf
'=====================================================================
' 软件名称:新云网站管理系统
' 当前版本:NewAsp Site Management System Version 3.0
' 文件名称:admin_loadskin.asp
' 更新日期:2006-11-20
' 官方网站:www.newasp.net   QQ:94022511
'=====================================================================
' Copyright 2003-2007 newasp.net - All Rights Reserved.
' newasp is a trademark of newasp.net
'=====================================================================
If Not ChkAdmin("TempLoad") Then
	Server.Transfer ("showerr.asp")
	Response.End
End If
mdbname = Newasp.CheckStr(Request("mdbname"))
Action = LCase(Request("action"))
Select Case Trim(Action)
	Case "del"
		Call DelTemplate
	Case "input"
		Call InputSkin
	Case "load"
		Call loadTemplate
	Case "loadskin"
		Call LoadSkin
	Case "skin"
		Call SkinsTemplate
	Case "rename"
		Call rename
	Case "savenm"
		Call savenm
	Case Else
		Call showmain
End Select
If Founderr = True Then
	ReturnError(ErrMsg)
End If
Admin_footer
SaveLogInfo(AdminName)
CloseConn
If IsObject(sConn) Then
	sConn.Close
	Set sConn = Nothing
End If

Sub showmain()
	Response.Write "<table border=0 align=center cellpadding=3 cellspacing=1 class=tableborder>"
	Response.Write "<tr>"
	Response.Write "	<th Colspan=3>模板导出</th>"
	Response.Write "</tr>"
	Response.Write "<tr>"
	Response.Write "	<td width=""70%"" Class=TableTitle align=center>模板名称</td>"
	Response.Write "	<td width=""20%"" Class=TableTitle align=center>操 作</td>"
	Response.Write "	<td width=""10%"" Class=TableTitle align=center>选 择</td>"
	Response.Write "<form name=selform method=post action=?action=input>"
	Response.Write "</tr>"
	SQL = "SELECT TemplateID,skinid,page_name FROM NC_Template WHERE pageid = 0"
	Set Rs = Newasp.Execute(SQL)
	Do While Not Rs.EOF
		Response.Write "<tr>"
		Response.Write "	<td class=tablerow1>"
		Response.Write Rs("page_name")
		Response.Write "	</td>"
		Response.Write "	<td class=tablerow1 align=center><a href=admin_template.asp?action=manage&skinid="
		Response.Write Rs("skinid")
		Response.Write ">编 辑</a> | "
		Response.Write "<a href=?action=rename&act=loadskin&skid="
		Response.Write Rs("TemplateID")
		Response.Write "&mdbname="
		Response.Write mdbname
		Response.Write ">改 名</a></td>"
		Response.Write "	<td class=tablerow1 align=center><input type=radio name=skinid value=""" & Rs("skinid") & """></td>"
		Response.Write "</tr>"
		Rs.movenext
	Loop
	Set Rs = Nothing
	Response.Write "<tr>"
	Response.Write "	<td Colspan=3 Class=TableRow1 align=center>模板数据库路径:<input type=text name=mdbname size=40 value="""
	Response.Write Newasp.InstallDir
	Response.Write "skin/NC_Skins.Mdb"">"
	Response.Write "	<input type=submit class=Button value=""导出模板"" onclick=""{if(confirm('您确定要导出该模板吗?')){return true;}return false;}""></td>"
	Response.Write "</tr>"
	Response.Write "</form>"
	Response.Write "</table>"

End Sub

Sub LoadTemplate()
	Response.Write "<table border=0 align=center cellpadding=3 cellspacing=1 class=tableborder>"
	Response.Write "<tr>"
	Response.Write "	<th Colspan=3>模板导入</th>"
	Response.Write "</tr>"
	Response.Write "<form name=myform method=post action=?action=skin>"
	Response.Write "<tr>"
	Response.Write "	<td Colspan=3 Class=TableRow1 align=center>模板数据库路径:<input type=text name=mdbname size=40 value="""
	Response.Write Newasp.InstallDir
	Response.Write "skin/NC_Skins.Mdb"">"
	Response.Write "	<input class=""Button"" type=""submit"" name=""B1"" value=""导入模板""> "
	Response.Write "	<input class=""Button"" type=""submit"" name=""B2"" value=""压缩数据库""> "
	Response.Write "</td>"
	Response.Write "</tr>"
	Response.Write "</form>"
	Response.Write "</table>"
End Sub

Sub SkinsTemplate()
	If Trim(Request.Form("mdbname")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>出错啦!^_^ 请选择模板数据库!</li>"
		Exit Sub
	End If
	If Trim(Request.Form("act")) = "压缩数据库" Then
		If CompressMDB(mdbname) Then OutHintScript("恭喜您 ^_^ 模板数据库压缩成功!")
		Exit Sub
	End If
	SkinConnection(mdbname)
	If FoundErr Then Exit Sub
	Response.Write "<table border=0 align=center cellpadding=3 cellspacing=1 class=tableborder>"
	Response.Write "<tr>"
	Response.Write "	<th Colspan=3>模板导入</th>"
	Response.Write "</tr>"
	Response.Write "<tr>"
	Response.Write "	<td width=""70%"" Class=TableTitle align=center>模板名称</td>"
	Response.Write "	<td width=""20%"" Class=TableTitle align=center>操 作</td>"
	Response.Write "	<td width=""10%"" Class=TableTitle align=center>选 择</td>"
	Response.Write "<form name=myform method=post action=?action=loadskin>"
	Response.Write "</tr>"
	SQL = "SELECT TemplateID,skinid,page_name FROM NC_Template WHERE pageid = 0"
	Set Rs = sConn.Execute(SQL)
	Do While Not Rs.EOF
		Response.Write "<tr>"
		Response.Write "	<td class=tablerow1>"
		Response.Write Rs("page_name")
		Response.Write "	</td>"
		Response.Write "	<td class=tablerow1 align=center><a href=?action=rename&act=loadskin&skid="
		Response.Write Rs("TemplateID")
		Response.Write "&mdbname="
		Response.Write mdbname
		Response.Write ">改 名</a> | "
		Response.Write "<a href=?action=del&skinid="
		Response.Write Rs("skinid")
		Response.Write "&mdbname="
		Response.Write mdbname
		Response.Write " onclick=""{if(confirm('模板删除后不能恢复,您确定要执行该操作吗?')){return true;}return false;}"">删 除</a></td>"
		Response.Write "	<td class=tablerow1 align=center><input type=radio name=skinid value=""" & Rs("skinid") & """></td>"
		Response.Write "</tr>"
		Rs.movenext
	Loop
	Set Rs = Nothing
	Response.Write "<tr>"
	Response.Write "	<td Colspan=3 Class=TableRow2 align=center>模板数据库路径:<input type=text name=mdbname size=40 value="""
	Response.Write mdbname
	Response.Write """>"
	Response.Write "	<input class=Button type=submit name=B1 value=""导入模板""  onclick=""{if(confirm('您确定要导入该模板吗?')){return true;}return false;}"">"
	Response.Write "	&nbsp;&nbsp;&nbsp;&nbsp;<input type=""checkbox"" name=""bestrow"" value=""yes"" title=""选择后将覆盖您现在的默认模板,如果确定此模板无误你可以选择覆盖默认模板""> <font color=""blue"">覆盖默认模板</font></td>"
	Response.Write "</tr>"
	Response.Write "</form>"
	Response.Write "</table>"

End Sub

Sub SkinConnection(mdbname)
	On Error Resume Next
	Set sConn = CreateObject("ADODB.Connection")
	sConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(mdbname)
	If Err Then
		Err.Clear
		Set sConn = Nothing
		ErrMsg = ErrMsg + "<li>" & mdbname & "数据库不存在。"
		Founderr = True
		Exit Sub
	End If
End Sub

Sub LoadSkin()
	If Trim(Request.Form("skinid")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>出错啦!^_^ 请选择你要导入的模板!</li>"
		Exit Sub
	End If
	If Trim(Request.Form("mdbname")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>出错啦!^_^ 请选择模板数据库!</li>"
		Exit Sub
	End If
	SkinConnection(mdbname)
	If FoundErr Then Exit Sub
	Dim SkinRs,newskinid,TemplateDir
	Dim TemplateFields,TemplateValues
	Dim bestrow,m_strChannelist,m_strTemplist
	Dim m_strListArray,m_intChannelID,chanid,m_intSkinID
	Dim isupdate,Rs1
	bestrow = Trim(Request("bestrow"))
	Set SkinRs = Conn.Execute("SELECT MAX(skinid) FROM [NC_Template] WHERE pageid = 0")
	If Not (SkinRs.EOF And SkinRs.BOF) Then
		newskinid = SkinRs(0)
	End If
	If IsNull(newskinid) Then newskinid = 0
	SkinRs.Close:Set SkinRs = Nothing
	newskinid = newskinid + 1
	m_strChannelist = ChannelIDList
	m_strTemplist = m_strChannelist
	SQL = "SELECT * FROM NC_Template WHERE skinid=" & CLng(Request("skinid")) & " ORDER BY ChannelID ASC,TemplateID ASC"
	Rs.Open SQL,sConn,1,1
	If Rs.BOF And Rs.EOF Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>出错啦!^_^ 没有找到你要导入的模板!</li>"
		Exit Sub
	End If
	Do While Not Rs.EOF
		If Not IsNull(Rs("TemplateDir")) Then
			TemplateDir = Newasp.CheckStr(Rs("TemplateDir"))
		Else
			TemplateDir = ""
		End If
		If InStr(m_strChannelist, "," & Rs("ChannelID") & ",") > 0  Then
			If bestrow = "yes" Then
				SQL = "UPDATE [NC_Template] SET TemplateDir='"& Rs("TemplateDir") &"',page_content='"& Newasp.CheckStr(Rs("page_content")) &"',page_setting='"& Newasp.CheckStr(Rs("page_setting")) &"',Template_Help='"& Newasp.CheckStr(Rs("Template_Help")) &"' WHERE ChannelID=" & Rs("ChannelID") & " And pageid=" & Rs("pageid") & " And isDefault=1"
			Else
				TemplateFields = "ChannelID,skinid,pageid,TemplateDir,page_name,page_content,page_setting,Template_Help,isDefault"
				TemplateValues = "" & Rs("ChannelID") & ","& newskinid &"," & Rs("pageid") & ",'" & TemplateDir & "','" & Newasp.CheckStr(Rs("page_name")) & "','" & Newasp.CheckStr(Rs("page_content")) & "','" & Newasp.CheckStr(Rs("page_setting")) & "','" & Newasp.CheckStr(Rs("Template_Help")) & "',0"
				SQL = "INSERT INTO [NC_Template](" & TemplateFields & ")VALUES(" & TemplateValues & ")"
			End If
			Conn.Execute (SQL)
			m_strTemplist = Replace(m_strTemplist, "," & Rs("ChannelID") & ",", ",")
		End If
		Rs.movenext
	Loop
	Rs.Close:Set Rs = Nothing
	'--导入新建频道模板
	If Len(m_strTemplist) > 2 Then
		m_strListArray = Split(m_strTemplist, ",")
		isupdate = False
		If UBound(m_strListArray) > 1 Then
			If bestrow = "yes" Then
				'-- 如果是覆盖默认模板得到默认皮肤ID
				Set Rs = Newasp.Execute("SELECT skinid FROM NC_Template WHERE isDefault=1")
				If Rs.BOF And Rs.EOF Then
					m_intSkinID = newskinid
				Else
					m_intSkinID = Rs(0)
				End If
				Set Rs = Nothing
			End If
			For i = 1 To UBound(m_strListArray) - 1
				'--频道ID
				chanid = Newasp.ChkNumeric(m_strListArray(i))
				'--模块ID
				m_intChannelID = GetChannelID(chanid)
				If m_intChannelID > 0 And m_intChannelID <> 9999 Then
					If bestrow = "yes" Then
						'--如果是覆盖默认模板,先判断模板是否存在
						'--如果模板存在就更新,否则就添加
						Set Rs1 = Newasp.Execute("SELECT skinid FROM NC_Template WHERE isDefault=1 And ChannelID=" & chanid)
						If Rs1.BOF And Rs1.EOF Then
							isupdate = False
						Else
							isupdate = True
						End If
						Set Rs1 = Nothing
					End If
					'--根据模块ID得到新建频道的模板
					Set Rs = Server.CreateObject("ADODB.Recordset")
					SQL = "SELECT * FROM NC_Template WHERE skinid=" & CLng(Request("skinid"))  & " And ChannelID=" & m_intChannelID & " ORDER BY pageid ASC,TemplateID ASC"
					Rs.Open SQL,sConn,1,1
					If Not(Rs.BOF And Rs.EOF) Then
						Do While Not Rs.EOF
							TemplateDir = ""
							TemplateFields = "ChannelID,skinid,pageid,TemplateDir,page_name,page_content,page_setting,Template_Help,isDefault"
							If bestrow = "yes" Then
								If isupdate Then
									SQL = "UPDATE [NC_Template] SET TemplateDir='"& Rs("TemplateDir") &"',page_content='"& Newasp.CheckStr(Rs("page_content")) &"',page_setting='"& Newasp.CheckStr(Rs("page_setting")) &"',Template_Help='"& Newasp.CheckStr(Rs("Template_Help")) &"' WHERE ChannelID=" & chanid & " And pageid=" & Rs("pageid") & " And isDefault=1"
								Else
									TemplateValues = "" & chanid & ","& m_intSkinID &"," & Rs("pageid") & ",'" & TemplateDir & "','" & Newasp.CheckStr(Rs("page_name")) & "','" & Newasp.CheckStr(Rs("page_content")) & "','" & Newasp.CheckStr(Rs("page_setting")) & "','" & Newasp.CheckStr(Rs("Template_Help")) & "',1"
									SQL = "INSERT INTO [NC_Template](" & TemplateFields & ")VALUES(" & TemplateValues & ")"
								End If
							Else
								TemplateValues = "" & chanid & ","& newskinid &"," & Rs("pageid") & ",'" & TemplateDir & "','" & Newasp.CheckStr(Rs("page_name")) & "','" & Newasp.CheckStr(Rs("page_content")) & "','" & Newasp.CheckStr(Rs("page_setting")) & "','" & Newasp.CheckStr(Rs("Template_Help")) & "',0"
								SQL = "INSERT INTO [NC_Template](" & TemplateFields & ")VALUES(" & TemplateValues & ")"
							End If
							Conn.Execute (SQL)
						Rs.movenext
						Loop
					End If
					Rs.Close:Set Rs = Nothing
				End If
			Next
		End If
	End If
	Response.Write "<script language=JavaScript>" & vbCrLf
	Response.Write "alert('恭喜您 ^_^ 模板导入成功啦!');"
	Response.Write "location.replace('admin_loadskin.asp')" & vbCrLf
	Response.Write "</script>" & vbCrLf
End Sub

Function ChannelIDList()
	Dim oRs,m_strList
	m_strList = ""
	SQL = "SELECT ChannelID,modules FROM NC_Channel WHERE ChannelType=1 ORDER BY ChannelID ASC"
	Set oRs = Conn.Execute(SQL)
	If Not(oRs.BOF And oRs.EOF) Then
		Do While Not oRs.EOF
			m_strList = m_strList & oRs(0) & ","
		oRs.movenext
		Loop
	End If
	oRs.Close:Set oRs = Nothing
	ChannelIDList = ",0,1,2,3,5,9999," & m_strList
End Function

Function GetChannelID(ByVal cid)
	Dim Rsc
	If cid = 9999 Or cid = 4 Then
		GetChannelID = 9999
		Exit Function
	End If
	Set Rsc = Conn.Execute("SELECT ChannelID,modules FROM NC_Channel WHERE ChannelID="&cid)
	If Rsc.BOF And Rsc.EOF Then
		GetChannelID = 0
	Else
		If Rsc(1) = 4 Then
			GetChannelID = 9999
		Else
			GetChannelID = Rsc(1)
		End If
	End If
	Set Rsc = Nothing
End Function

Sub InputSkin()
	If Trim(Request.Form("skinid")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>出错啦!^_^ 请选择你要导出的模板!</li>"
		Exit Sub
	End If
	If Trim(Request.Form("mdbname")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>出错啦!^_^ 请选择你要导出的模板数据库!</li>"
		Exit Sub
	End If
	SkinConnection(mdbname)
	If FoundErr Then Exit Sub
	Dim SkinRs,newskinid,TemplateDir
	Dim TemplateFields,TemplateValues
	Set SkinRs = sConn.Execute("SELECT MAX(skinid) FROM [NC_Template] WHERE pageid = 0")
	If Not (SkinRs.EOF And SkinRs.BOF) Then
		newskinid = SkinRs(0)
	End If
	If IsNull(newskinid) Then newskinid = 0
	SkinRs.Close:Set SkinRs = Nothing
	newskinid = newskinid + 1
	SQL = "SELECT * FROM NC_Template WHERE skinid = " & CLng(Request("skinid"))
	Rs.Open SQL,Conn,1,1
	If Rs.bof And Rs.EOF Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>出错啦!^_^ 没有找到你要导出的模板!</li>"
		Exit Sub
	End If
	Do While Not Rs.EOF
		If Not IsNull(Rs("TemplateDir")) And Rs("pageid")=0 Then
			TemplateDir = Newasp.CheckStr(Rs("TemplateDir"))
		Else
			TemplateDir = ""
		End If
		TemplateFields = "ChannelID,skinid,pageid,TemplateDir,page_name,page_content,page_setting,Template_Help,isDefault"
		TemplateValues = "" & Rs("ChannelID") & ","& newskinid &"," & Rs("pageid") & ",'" & TemplateDir & "','" & Newasp.CheckStr(Rs("page_name")) & "','" & Newasp.CheckStr(Rs("page_content")) & "','" & Newasp.CheckStr(Rs("page_setting")) & "','" & Newasp.CheckStr(Rs("Template_Help")) & "',0"
		SQL = "INSERT INTO [NC_Template](" & TemplateFields & ")VALUES(" & TemplateValues & ")"
		sConn.Execute (SQL)
		Rs.movenext
	Loop
	Rs.Close:Set Rs = Nothing
	Response.Write "<script language=JavaScript>" & vbCrLf
	Response.Write "alert('恭喜您 ^_^ 模板导出成功啦!');"
	Response.Write "location.replace('admin_loadskin.asp')" & vbCrLf
	Response.Write "</script>" & vbCrLf
End Sub

Sub rename()
	Dim sRs,skid
	'模板改名
	skid = Newasp.checkStr(Request("skid"))
	mdbname = Newasp.checkStr(Trim(Request("mdbname")))
	If skid <> "" And IsNumeric(skid) Then skid = CLng(skid) Else skid = 1
	If Request("act") = "loadskin" And mdbname <> "" Then
		SkinConnection (mdbname)
		Set sRs = sConn.Execute("SELECT TemplateID,page_name,skinid FROM NC_Template WHERE TemplateID=" & skid)
	Else
		Set sRs = Newasp.Execute("SELECT TemplateID,page_name,skinid FROM NC_Template WHERE TemplateID=" & skid)
	End If
	Response.Write "<form action=""?action=savenm"" method=post >" & vbCrLf
	Response.Write "<table border=""0"" cellspacing=""1"" cellpadding=""5"" align=center class=""tableBorder"">" & vbCrLf
	Response.Write "<tr><th colspan=""2"">更改模版名称 ID="
	Response.Write sRs(2)
	Response.Write "</td></tr>" & vbCrLf
	Response.Write "<tr>" & vbCrLf
	Response.Write Chr(9) & "<td width=""20%"" class=""TableRow1"">模版原名:</td>" & vbCrLf
	Response.Write Chr(9) & "<td width=""80%"" class=""TableRow1"">"
	Response.Write sRs(1)
	Response.Write "</td>" & vbCrLf
	Response.Write "</tr>" & vbCrLf
	Response.Write "<tr>" & vbCrLf
	Response.Write Chr(9) & "<td class=""TableRow1"">模版新名:</td>" & vbCrLf
	Response.Write Chr(9) & "<td class=""TableRow1""><input type=""text"" name=""skinNAME"" size=""30"" value=""""></td>" & vbCrLf
	Response.Write "</tr>" & vbCrLf
	Response.Write "<tr><td align=center class=TableRow2 colspan=""2""><input class=button type=""submit"" name=""submit"" value=""更 新""></td></tr>" & vbCrLf
	If Request("act") = "loadskin" Then
		Response.Write "<input TYPE=""hidden"" NAME=""mdbname"" VALUE="""
		Response.Write mdbname
		Response.Write """>" & vbCrLf
	End If
	Response.Write "<input TYPE=""hidden"" NAME=""skid"" VALUE="""
	Response.Write sRs(0)
	Response.Write """>" & vbCrLf
	Response.Write "<input TYPE=""hidden"" NAME=""act"" VALUE="""
	Response.Write Request("act")
	Response.Write """>" & vbCrLf
	Response.Write "</table></form>" & vbCrLf
	sRs.Close
	Set sRs = Nothing
End Sub

Sub savenm()
	Dim skinNAME,skid
	'模板改名保存
	skid = Newasp.checkStr(Request.Form("skid"))
	mdbname = Newasp.checkStr(Trim(Request.Form("mdbname")))
	skinNAME = Newasp.checkStr(Trim(Request.Form("skinname")))
	If skid = "" Or Not IsNumeric(skid) Then
		ErrMsg = ErrMsg + "<BR><li>请选择正确的参数</li>"
		Exit Sub
	End If
	If skinNAME = "" Then
		ErrMsg = ErrMsg + "<li>新模板名称不能为空!</li>"
		Exit Sub
	End If
	If Request("act") = "loadskin" And mdbname <> "" Then
		SkinConnection(mdbname)
		sConn.Execute ("UPDATE NC_Template SET page_name='" & skinNAME & "'  WHERE TemplateID=" & skid)
	Else
		Newasp.Execute ("UPDATE NC_Template SET page_name='" & skinNAME & "'  WHERE TemplateID=" & skid)
	End If
	Succeed ("<li>恭喜您,模板更名成功!")
End Sub
Sub DelTemplate()
	If Trim(Request("skinid")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>出错啦!^_^ 请选择你要删除的模板!</li>"
		Exit Sub
	End If
	If Trim(Request("mdbname")) = "" Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>出错啦!^_^ 请选择你要删除的模板数据库!</li>"
		Exit Sub
	End If
	SkinConnection(mdbname)
	If FoundErr Then Exit Sub
	sConn.Execute("DELETE FROM NC_Template WHERE skinid = " & CLng(Request("skinid")))
	Response.Write "<script language=JavaScript>" & vbCrLf
	Response.Write "alert('呵呵 ^_^ 模板删除成功啦!');"
	Response.Write "location.replace('admin_loadskin.asp?action=load')" & vbCrLf
	Response.Write "</script>" & vbCrLf
End Sub
'================================================
' 函数名:CompressMDB
' 作  用:压缩ACCESS数据库
' 参  数:dbPath ----数据库路径
' 返回值:True  ----  False
'================================================
Public Function CompressMDB(DBPath)
        Dim fso, Engine, strDBPath
        CompressMDB = False
        If DBPath = "" Then Exit Function
        If InStr(DBPath, ":") = 0 Then DBPath = Server.MapPath(DBPath)
        strDBPath = Left(DBPath, InStrRev(DBPath, "\"))
        Set fso = CreateObject(Newasp.FSO_ScriptName)

        If fso.FileExists(DBPath) Then
                fso.CopyFile DBPath, strDBPath & "temp.mdb"
                Set Engine = CreateObject("JRO.JetEngine")

                Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb", _
                "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp1.mdb"

                fso.CopyFile strDBPath & "temp1.mdb", DBPath
                fso.DeleteFile (strDBPath & "temp.mdb")
                fso.DeleteFile (strDBPath & "temp1.mdb")
                Set fso = Nothing
                Set Engine = Nothing
                CompressMDB = True
        Else
                CompressMDB = False
        End If
End Function


%>