📄 admin_function.asp
字号:
<%
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.cachecontrol = "no-cache"
%>
<script language="javascript">
<!--
if (window == top)top.location.href = "admin.asp";
// -->
</script>
<script language="Javascript">
//上存
function openem()
{
var s;
var a;
a=window.showModalDialog("Up.asp?action=add","","dialogWidth:300px;dialogHeight:150px;scroll:no;status:no");
if(a!=undefined)
{s
document.all.pic.value=a;
}
}
//上存软件下载展示图片
function openem_soft()
{
var s;
var a;
a=window.showModalDialog("Up.asp?action=add","","dialogWidth:300px;dialogHeight:150px;scroll:no;status:no");
if(a!=undefined)
{s
document.all.Bigpic.value=a;
}
}
//上存软件下载展示图片
function openem_SoftDown1()
{
var s;
var a;
a=window.showModalDialog("Up.asp?action=add","","dialogWidth:300px;dialogHeight:150px;scroll:no;status:no");
if(a!=undefined)
{s
document.all.SoftDown1.value=a;
}
}
//上存
function Gaobei_UpBig()
{
var s;
var b;
b=window.showModalDialog("Up.asp?action=add","","dialogWidth:300px;dialogHeight:150px;scroll:no;status:no");
if(b!=undefined)
{s
document.all.piclink.value=b;
}
}
//弹出上存窗口
function killErrors() {
return true;
}
window.onerror = killErrors;
function openScript(url, width, height){
var Win = window.open(url,"openScript",'width=' + width + ',height=' + height + ',left=450,top=300,resizable=1,scrollbars=no,menubar=no,status=no' );
}
function openem2()
{
openScript('upload.asp',300,100);
}
function preview(){
window.open(document.form.pic.value)
}
// 当上传图片等文件时，往下拉框中填入图片路径，可根据实际需要更改此函数
function doChange(objText, objDrop){
if (!objDrop) return;
var str = objText.value;
var arr = str.split("|");
var nIndex = objDrop.selectedIndex;
objDrop.length=1;
for (var i=0; i<arr.length; i++){
objDrop.options[objDrop.length] = new Option(arr[i], arr[i]);
}
objDrop.selectedIndex = nIndex;
}
//Other NoPic
function pic(smileface)
{
document.form.pic.value=smileface;
}
</Script>
<%
'常用函数页
'一些信息的过虑--------------------
function strFilter(str)
str=Replace(str,"'","''")
str=replace(str,"|","/")
str=Replace(str,"' ","'")
strFilter=str
end function
'管理后台头部----------------------
function header(popedomnum,titmenu)
header = VbCrLf & "<html><head><title>后台管理</title>" & _
VbCrLf & "<meta http-equiv=Content-Type content=text/html; charset=gb2312>" & _
VbCrLf & "<link rel=stylesheet href='img/admin.css' type=text/css>" & _
VbCrLf & "</head>" & VbCrLf & "<body topmargin=0 leftmargin=0><center>" & _
VbCrLf & "<table border=0 width=95% cellspacing=0 cellpadding=0>" & _
vbcrlf & "<tr><td height=30 align=center>"&titmenu&" ┋ <a href='javascript:;' onclick=""javascript:document.location.reload()"">刷新</a></td></tr></table><br>"
end function
function code_html(strers,chtype,cutenum)
dim strer:strer=strers
if isnull(strer) or strer="" then code_html="":exit function
strer=health_var(strer,1)
if cutenum>0 then strer=cuted(strer,cutenum)
strer=replace(strer,"<","<")
strer=replace(strer,">",">")
strer=replace(strer,chr(39),"'") '单引号
strer=replace(strer,chr(34),""") '双引号
strer=replace(strer,chr(32)," ") '空格
select case chtype
case 1
strer=replace(strer,chr(9)," ") 'table
strer=replace(strer,chr(10),"") '回车
strer=replace(strer,chr(13),"")
case 2
strer=replace(strer,chr(9)," ")'table
strer=replace(strer,chr(10),"<br>") '回车
strer=replace(strer,chr(13),"<br>")
end select
code_html=strer
end function
function health_var(hnn,vt)
dim ti,tj,tdim,ht,hn:hn=hnn
if vt=1 then
tdim=split(web_Badwords,"|")
for ti=0 to ubound(tdim)
ht=""
for tj=1 to len(tdim(ti))
ht=ht&"*"
next
hn=replace(hn,tdim(ti),ht)
next
erase tdim
end if
health_var=hn
end function
function code_admin(strers)
dim strer:strer=trim(strers)
if isnull(strer) or strer="" then code_admin="":exit function
strer=replace(strer,"'","""")
code_admin=strer
end function
'判断发言是否来自外部--------------
function post_chk()
dim server_v1,server_v2
post_chk="no"
server_v1=Request.ServerVariables("HTTP_REFERER")
server_v2=Request.ServerVariables("SERVER_NAME")
if mid(server_v1,8,len(server_v2))=server_v2 then post_chk="yes":exit function
end function
'函数名：IsObjInstalled
'作 用：检查组件是否已经安装
'参 数：strClassString ----组件名
'返回值：True ----已经安装
' False ----没有安装
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
'函数名：JoinChar
'作 用：向地址中加入 ? 或 &
'参 数：strUrl ----网址
'返回值：加了 ? 或 & 的网址
function JoinChar(strUrl)
if strUrl="" then
JoinChar=""
exit function
end if
if InStr(strUrl,"?")<len(strUrl) then
if InStr(strUrl,"?")>1 then
if InStr(strUrl,"&")<len(strUrl) then
JoinChar=strUrl & "&"
else
JoinChar=strUrl
end if
else
JoinChar=strUrl & "?"
end if
else
JoinChar=strUrl
end if
end function
%>
<%'===========================================以下为下载里的function.asp====================%>
<%
' 错误返回处理
' ============================================
Sub GoError(str)
Call DBConnEnd()
Response.Write "<script language=javascript>alert('" & str & "\n\n系统将自动返回前一页面...');history.back();</script>"
Response.End
End Sub
'**************************************************
'过程名：WriteErrMsg
'作 用：显示错误提示信息
'参 数：无
'**************************************************
sub WriteErrMsg()
dim strErr
strErr=strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
strErr=strErr & "<link href='../admin/js/common.css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
strErr=strErr & "<table cellpadding=2 width='400' border='0' cellpadding='3' cellspacing='1' bgcolor='#DEDFDE' align=center>" & vbcrlf
strErr=strErr & " <tr align='center' bgcolor='#F7F7F7'><td height='22'><strong>错误信息</strong></td></tr>" & vbcrlf
strErr=strErr & " <tr bgcolor='#FFFFFF'><td height='100' valign='top'><b>产生错误的可能原因：</b>" & errmsg &"</td></tr>" & vbcrlf
strErr=strErr & " <tr align='center' bgcolor='#FFFFFF'><td><a href='javascript:history.go(-1)'><< 返回上一页</a></td></tr>" & vbcrlf
strErr=strErr & "</table>" & vbcrlf
strErr=strErr & "</body></html>" & vbcrlf
response.write strErr
end sub
' ============================================
' 得到安全字符串,在查询中或有必要强行替换的表单中使用
' ============================================
Function GetSafeStr(str)
GetSafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")
End Function
' ============================================
' 把字符串进行HTML解码,替换server.htmlencode
' 去除Html格式，用于显示输出
' ============================================
Function outHTML(str)
Dim sTemp
sTemp = str
outHTML = ""
If IsNull(sTemp) = True Then
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
sTemp = Replace(sTemp, Chr(10), "<br>")
outHTML = sTemp
End Function
' ============================================
' 去除Html格式，用于从数据库中取出值填入输入框时
' 注意：value="?"这边一定要用双引号
' ============================================
Function inHTML(str)
Dim sTemp
sTemp = str
inHTML = ""
If IsNull(sTemp) = True Then
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -