📄 act.data.asp
字号:
<!--#include file="ACT.Function.asp"-->
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>数据库操作 By ACTCMS</title>
<link href="Images/css1/css.css" rel="stylesheet" type="text/css">
</head>
<%
If Not ACTCMS.ChkAdmin() Then '超级管理员检测
Call Actcms.ACTCMSErr("")
End If
Dim ShowErr
Select Case Request.QueryString("Type")
Case "bak"'备份
Call act_bak()
Case "bakdata"'备份数据库
Call bakdata()
Case "Compress"
Call Compress()
Case "CompactDatabase"
Call CompactDatabase()
Case Else
Call Main()
End Select
Sub Main()
if request.QueryString("Flag") ="Result" then
Response.Write ("<body style=""margin:1;"">")
Call ExecuteSql
else
%>
<form name="ExecuteForm" method="post" Action="?Action=ExecSql" onSubmit="return CheckForm()">
<table width="98%" border="0" align="center" cellpadding="2" cellspacing="1" class="table">
<tr>
<td class="bg_tr">您现在的位置：系统设置 >> 数据库维护 <a href="#" target="_blank" style="cursor:help;'" class="Help">帮助</a></td>
</tr>
<tr>
<td class="td_bg">首页 ｜ <a href="?Type=Compress">数据库压缩</a> ｜ <a href="?Type=bak">数据库备份</a> ｜ SQL语句查询操作</td>
</tr>
</table>
<table width="98%" border="0" align="center" cellpadding="2" cellspacing="1" class="table">
<tr>
<td class="bg_tr">您现在的位置：系统设置 >> 数据库维护 <a href="#" target="_blank" style="cursor:help;'" class="Help">帮助</a></td>
</tr>
<tr>
<td class="td_bg">说明：注：一次只能执行一条Sql语句。如果你对SQL不熟悉，请尽量不要使用。否则一旦出错，将是致命的。<br>
建议使用查询语句.如：Select Title From Article order by ArticleID desc,尽量不要使用delete,update等命令</td>
</tr>
<tr>
<td class="td_bg"><textarea name="Sql" rows="5" wrap="OFF" style="width:100%;"></textarea></td>
</tr>
<tr>
<td class="td_bg"><iframe id="ExecuteSQLFrame" scrolling="auto" src="ACT.Data.asp?Action=ExecSql&Flag=Result" style="width:100%;height:255" frameborder=1></iframe></td>
</tr>
<tr>
<td class="td_bg">
<input type="submit" name="submit1" class="ACT_btn" value="立即执行">
</td>
</tr>
</table>
</form>
<% end if
End Sub%>
<%
Sub ExecuteSQL()
Dim SelectSQLTF,ExecSQLErrorTF,ExeResultNum,ExeResult,FiledObj
Dim Sql:Sql =request.querystring("Sql")
if SQL="" Then Exit Sub
If Instr(1,lcase(Sql),"delete from log")<>0 then
response.Write "error"
Exit Sub
End If
SelectSQLTF = (LCase(Left(Trim(Sql),6)) = "select")
Conn.Errors.Clear
On Error Resume Next
if SelectSQLTF = True then
Set ExeResult = Conn.Execute(Sql,ExeResultNum)
else
Conn.Execute Sql,ExeResultNum
end if
If Conn.Errors.Count<>0 Then
ExecSQLErrorTF = True
Set ExeResult = Conn.Errors
Else
ExecSQLErrorTF = False
End If
if ExecSQLErrorTF = True then
%>
<table width="100%" cellpadding="0" cellspacing="1" class="table">
<tr class="bg_tr">
<td height="20" nowrap>
<div align="center">错误号</div></td>
<td height="20" nowrap>
<div align="center">来源</div></td>
<td height="20" nowrap>
<div align="center">描述</div></td>
<td height="20" nowrap>
<div align="center">帮助</div></td>
<td height="20" nowrap>
<div align="center">帮助文档</div></td>
</tr>
<tr height="20" class="td_bg">
<td nowrap>
<% = Err.Number %> </td>
<td nowrap>
<% = Err.Description %> </td>
<td nowrap>
<% = Err.Source %> </td>
<td nowrap>
<% = Err.Helpcontext %> </td>
<td nowrap>
<% = Err.HelpFile %> </td>
</tr>
</table>
<%
else
%>
<table border="0" cellpadding="0" cellspacing="1" class="table">
<%
if SelectSQLTF = True then
%>
<tr>
<%
For Each FiledObj In ExeResult.Fields
%>
<td class="bg_tr" nowrap height="26"><div align="center">
<strong><% = FiledObj.name %></strong>
</div></td>
<%
next
%>
</tr>
<%
do while Not ExeResult.Eof
%>
<tr height="20" nowrap class="td_bg" >
<%
For Each FiledObj In ExeResult.Fields
%>
<td>
<div align="center">
<%
if IsNull(FiledObj.value) then
Response.Write(" ")
else
Response.Write(FiledObj.value)
end if
%>
</div></td>
<%
next
%>
</tr>
<%
ExeResult.MoveNext
loop
else
%>
<tr>
<td height="26">
<div align="center">执行结果</div></td>
</tr>
<tr>
<td height="20" class="td_bg">
<div align="center">
<% = ExeResultNum & "条纪录被影响"%>
</div></td>
</tr>
<%
end if
%>
</table>
<%
end if
End Sub
sub bakdata()
'On error resume next
Dim FileConnStr,Fileconn,Dbpath,bkfolder,bkdbname,fso
Dim Tempbackpath
Dbpath=Replace(request.Form("Dbpath"),chr(0),"")
Dbpath=Server.mappath(Dbpath)
bkfolder=Replace(request.Form("bkfolder"),chr(0),"")
bkdbname=Replace(request.Form("bkdbname"),chr(0),"")
Tempbackpath = bkfolder& "/"& bkdbname
If Lcase(Mid(Tempbackpath,instrRev(Tempbackpath,".")+1))<>"mdb" Then
response.write "保存数据库名不合法,必须是有效的MDB文件!"
Response.End
End If
FileConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Dbpath
Set Fileconn = Server.CreateObject("ADODB.Connection")
Fileconn.open FileConnStr
If Err Then
Response.Write Err.Description
Err.Clear
Set Fileconn = Nothing
ShowErr = "备份的文件并非合法的数据库。"
Response.Redirect("Error.asp?Errs="&Server.URLEncode(ShowErr)&"&ErrorUrl="&"&Title=1")
Response.end
Exit Sub
Else
Set Fileconn = Nothing
End If
Set Fso=server.createobject("scripting.filesystemobject")
If Fso.fileexists(dbpath) then
If CheckDir(bkfolder) = True Then
Fso.copyfile dbpath,Server.mappath(Tempbackpath)
Else
If MakeNewsDir(bkfolder) = True Then
Fso.copyfile dbpath,Server.mappath(Tempbackpath)
Else
ShowErr = "该目录"&bkfolder&"创建失败，请检查路径是否填写正确或手工创建后再进行备份。"
Response.Redirect("Error.asp?Errs="&Server.URLEncode(ShowErr)&"&ErrorUrl="&"&Title=1")
Response.end
End if
End if
ShowErr = ("备份数据库成功，您备份的数据库路径为" &Tempbackpath)
Response.Redirect("Error.asp?Errs="&Server.URLEncode(ShowErr)&"&ErrorUrl=")
Response.end
Else
ShowErr = "找不到您所需要备份的文件。"
Response.Redirect("Error.asp?Errs="&Server.URLEncode(ShowErr)&"&ErrorUrl="&"&Title=1")
Response.end
End if
end Sub
Sub act_bak()
%>
<table width="100%" height="1" border="0" align=center cellpadding="5" cellspacing="1" class="table">
<tr>
<th height=25 class="bg_tr" style="text-align:center;">
<B>备份论坛数据</B>( 需要FSO支持，FSO相关帮助请看微软网站 ) </th>
</tr>
<form method="post" action="?Type=bakdata">
<tr>
<td height=100 class="td_bg">
当前数据库路径(相对路径)：
<input type=text size=50 name=DBpath value="<%=MyDbPath&db%>">
<BR>
备份数据库目录(相对路径)：
<input type=text size=50 name=bkfolder value="../Databackup"> 如目录不存在，程序将自动创建<BR>
备份数据库名称(填写名称)：
<input type=text size=50 name=bkDBname value="ActCMS_Backup_<%=date%>.mdb"> 如备份目录有该文件，将覆盖，如没有，将自动创建<BR>
<input type=submit class="ACT_btn" value="确定">
<br>
-----------------------------------------------------------------------------------------<br> 在上面填写本程序的数据库路径全名，本程序的默认数据库文件为Data\ActCMS.asp，<B>请一定不能用默认名称命名备份数据库</B><br> 您可以用这个功能来备份您的法规数据，以保证您的数据安全！<br> 注意：所有路径都是相对与程序空间根目录的相对路径 </font> </td>
</tr>
</form>
</table>
<%End Sub
Sub Compress()
%>
<table width="100%" height="1" border="0" align=center cellpadding="5" cellspacing="1" class="table">
<form action="?Type=CompactDatabase" method="post">
<tr>
<td class="td_bg" height=25><b>注意：</b><br>
输入数据库所在相对路径,并且输入数据库名称 </td>
</tr>
<tr>
<td class="td_bg">压缩数据库：<input name="dbpath" type="text" value="<%=actcms.actsys&db%>" size="50">
<input type="submit" class="button" value="开始压缩"></td>
</tr>
<form>
</table>
<%End sub
Public Function CompactDatabase()
dim dbpath
dbpath = request("dbpath")
On Error Resume Next
Dim strTempFile, fso, jro, ver, strCon, strTo, LCID
Set fso = Server.CreateObject("Scripting.FileSystemObject")
strTempFile = DBPath
strTempFile = Left(strTempFile, InStrRev(strTempFile, "\")) & fso.GetTempName
Set jro = Server.CreateObject("JRO.JetEngine")
LCID = Conn.Properties("Locale Identifier").Value
CloseConn
strTo = "Provider=Microsoft.Jet.OLEDB.4.0; Locale Identifier=" & LCID & "; Data Source=" & Server.MapPath(strTempFile) & "; Jet OLEDB:Engine Type=" & ver
jro.CompactDatabase ConnStr, strTo
CompactDatabase = False
If Err Then
fso.DeleteFile Server.MapPath(strTempFile)
Else
fso.DeleteFile Server.MapPath(DBPath)
fso.MoveFile Server.MapPath(strTempFile), Server.MapPath(DBPath)
If Err Then
fso.DeleteFile Server.MapPath(strTempFile)
Else
CompactDatabase = True
End If
End If
Set jro = Nothing
Set fso = Nothing
'重新打开数据库
ConnectionDatabase()
if CompactDatabase=true then
ShowErr = "数据库压缩和修复成功"
else
ShowErr = "操作失败"
end if
Response.Redirect("Error.asp?Errs="&Server.URLEncode(ShowErr)&"&ErrorUrl=")
Response.end
End Function
Function CheckDir(FolderPath)
dim fso1
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)
dim f,fso1
MakeNewsDir = False
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set f = fso1.CreateFolder(foldername)
MakeNewsDir = True
Set fso1 = nothing
End Function
%>
<script language="javascript">
<!--
function CheckForm()
{if (document.ExecuteForm.Sql.value=='')
{
alert('请输入SQL查询语句！');
document.ExecuteForm.Sql.focus();
return false;
}
ExecuteSQLFrame.location.href="ACT.Data.asp?Action=ExecSql&Flag=Result&SQL="+document.ExecuteForm.Sql.value;
return false;
}
-->
</script>
</BODY>
</HTML>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -