admin_data.asp

电子商城代码

<!--#include file="conn.asp"-->
<%
admintop()
Select case request("action")
       Case "backup" : backup()
	   Case "backupdata" : backupdata()
	   Case "yasuo" : yasuo()
	   Case "cacheupdate" : cacheupdate()
	   Case Else
	             cache()
	   End Select


Sub Cacheupdate
Dim admin_flag
    admin_flag=",40,"
	if session("admin_name")="" or instr(","&session("flag")&",",admin_flag)=0 then
	adminflag()	
	else
       Dim strsave
       Application.Contents.RemoveAll
       strsave= "缓存已更新。"
	   response.redirect"admin_data.asp?strsave="&strsave&""
	   response.End
    End if
End Sub
Function UpC(ByVal AppCount)
Dim i
For i = 0 to AppCount+10
    Application.Lock
    Application.Contents.Remove(Application.Contents.key(i))
	Application.unLock
Next
End Function

Sub cache
    admin_flag=",40,"
	if session("admin_name")="" or instr(","&session("flag")&",",admin_flag)=0 then
	adminflag()	
	else
%>
<table border="0" cellspacing="1" cellpadding="0" height="0" align=center width="98%" bgcolor="#183789">
  <tr>
  <td>
   <table border="0" cellspacing="1" cellpadding="4" bgcolor="#FFFFFF" align="center" width="100%">
<tr>
<td class="classtop" height="27" colspan="2" align="center">更新系统缓存</strong></td>
</tr>
<tr bgcolor="#D6DFF7">
<td height="22" colspan="2"><%=request("strsave")%></td>
</tr>
<form method="post" action="?action=cacheupdate">
<tr bgcolor="#D6DFF7">
<td height="22" colspan="2">
当您改变了网站的一些设置时，存储在内存里的数据有时不会自动马上更新，如果你要马上更新，就点 [更新系统缓存] ！<br>
本站共用<FONT  COLOR="#FF0033"><%=Application.Contents.Count%></FONT> 个缓存</td>
</tr>
<tr>
<td height="30" colspan="2" class="classfooter" align="center"><input type=submit value="更新系统缓存" class="button">
</td>
</tr>
</table></td>
</form>
</tr>
</table>
<%
end If
End Sub


Sub backup
       Dim admin_flag
       admin_flag=",41,"
       if session("admin_name")="" or instr(","&session("flag")&",",admin_flag)=0 then
       adminflag()	
       else
%>
<table border="0" cellspacing="1" cellpadding="0" height="0" align=center width="98%" bgcolor="#183789">
  <tr>
  <td>
   <table border="0" cellspacing="1" cellpadding="4" bgcolor="#FFFFFF" align="center" width="100%">
<tr>
<td class="classtop" height="27" colspan="2" align="center">备份数据库</strong>[需要FSO权限]</td>
</tr>
<%
datename=now()
datename=replace(datename, "-", "")
datename=replace(datename, " ", "")
datename=replace(datename, ":", "")
if request("action")="Backupdata" then
%>
<tr bgcolor="#D6DFF7">
<td height="22" colspan="2"><%call backupdata()%></td>
</tr>
<%else%>
<form method="post" action="?action=backupdata">
<tr bgcolor="#D6DFF7">
<td height="22" colspan="2">
您可以用这个功能来备份您的法规数据，以保证您的数据安全！<br>
数据库备份目录为 Databackup
<br>为了程序的安全，这里均使用默认信息，不允许自行设置！</td>
</tr>
<tr>
<td height="30" colspan="2" class="classfooter" align="center"><input type=submit value="备份数据库" class="button">
<input type=hidden name=bkfolder value=Databackup>
<input type=hidden name=DBpath value="<%=db%>">
<input type=hidden name=bkDBname value="#<%=datename%>.asa">
</td>
</tr>
</table></td>
</form>
</tr>
</table>
<%
end if
end If
End Sub

sub backupdata()
Dbpath=request.form("Dbpath")
If dbpath="" Then dbpath="default.asp"
Dbpath=server.mappath(Dbpath)
bkfolder=request.form("bkfolder")
bkdbname=request.form("bkdbname")
Set Fso=server.createobject("scripting.filesystemobject")
if fso.fileexists(dbpath)then
        If CheckDir(bkfolder)= True Then
fso.copyfile dbpath, bkfolder& "\"& bkdbname&".bak"
else
        MakeNewsDir bkfolder
fso.copyfile dbpath, bkfolder& "\"& bkdbname&".bak"
end if
%>
<table border="0" cellspacing="1" cellpadding="0" height="0" align=center width="98%" bgcolor="#183789">
  <tr>
  <td>
   <table border="0" cellspacing="1" cellpadding="4" bgcolor="#FFFFFF" align="center" width="100%">
<tr>
<td class="classtop" height="27" colspan="2" align="center">备份数据库</strong>[需要FSO权限]</td>
</tr>
<tr bgcolor="#D6DFF7">
<td height="22" colspan="2">备份数据库成功</td>
</tr>
</table>
</td>
</tr>
</table>
<%

Else
response.write "找不到您所需要备份的文件。"
End if
end Sub

'检查某一目录是否存在
Function CheckDir(FolderPath)
folderpath=Server.MapPath(".")&"\"&folderpath
Set fso1 = CreateObject("Scripting.FileSystemObject")
If fso1.FolderExists(FolderPath)then
'存在
CheckDir = True
Else
'不存在
CheckDir = False
End if
Set fso1 = nothing
End Function
'根据指定名称生成目录
Function MakeNewsDir(foldername)
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set f = fso1.CreateFolder(foldername)
MakeNewsDir = True
Set fso1 = nothing
End Function
%>

<%
Sub yasuo
Dim admin_flag
admin_flag=",42,"
if session("admin_name")="" or instr(","&session("flag")&",",admin_flag)=0 then
adminflag()	
else
%>
<table border="0" cellspacing="1" cellpadding="0" height="0" align=center width="98%" bgcolor="#183789">
<form name="xxyf" method="post" action="?action=yasuo">
  <tr>
  <td>
   <table border="0" cellspacing="1" cellpadding="4" bgcolor="#FFFFFF" align="center" width="100%">
<tr>
<td class="classtop" height="27" colspan="2">
<div align="center"><strong>压缩数据库</strong>[需要FSO权限]</div></td>
</tr>
<tr class="classtf">
<td height="25" colspan="2">
<font color="RED">注意：此功能需要服务器给予FSO权限支持，否则不能使用！
</font></td>
</tr>
<tr>
<td height="25" colspan="2" class="classtd" align="center">
<%
dim dbpath,boolIs97
dbpath = request("dbpath")
boolIs97 = request("boolIs97")

If dbpath <> "" Then
dbpath = server.mappath(dbpath)
	response.write(CompactDB(dbpath,boolIs97))
End If

'end sub


%>
</td>
</tr>
<tr>
<td height="30" colspan="2" class="classfooter" align="center">
<input type="submit" name="submit" value="压缩数据库" class="button">
<input type="hidden" name="dbpath" value="<%=db%>">
</td>
</tr>
</form>
</table>
<%end If
End Sub
'=====================压缩参数=========================
Function CompactDB(dbPath, boolIs97)
Dim fso, Engine, strDBPath,JET_3X
strDBPath = left(dbPath,instrrev(DBPath,"\"))
Set fso = CreateObject("Scripting.FileSystemObject")

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

	If boolIs97 = "True" Then
		Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password="&Pass&";Data Source=" & strDBPath & "temp.mdb", _
		"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp1.mdb;" _
		& "Jet OLEDB:Engine Type=" & JET_3X
	Else
		Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password="&Pass&";Data Source=" & strDBPath & "temp.mdb", _
		"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp1.mdb"
	End If

fso.CopyFile strDBPath & "temp1.mdb",dbpath
fso.DeleteFile(strDBPath & "temp.mdb")
fso.DeleteFile(strDBPath & "temp1.mdb")
Set fso = nothing
Set Engine = nothing

	CompactDB = "数据库压缩成功!" & vbCrLf

Else
	CompactDB = "数据库名称或路径不正确. 请重试!" & vbCrLf
End If

End Function
%>