📄 inc.asp
字号:
<%
Dim colnum
'性别学历定义,下拉
Dim arr_Gender(2)
arr_Gender(1)="男"
arr_Gender(2)="女"
Dim arr_lq(1)
arr_lq(0)="处理中"
arr_lq(1)="正式录取"
'================================================================
'搜索语句构造
'Sql_Lists 搜索列名
'Sql_tables 操作表名
'Sql_Condition 条件
'Sql_Sortings 排序
'Sql_Orders 0为顺序 1为倒序
'Sql_Additional 分组group by
'================================================================
Function Sqlinfo(Sql_Lists,Sql_tables,Sql_Conditions,Sql_Sortings,Sql_Orders,Sql_Additional)
If Sql_Lists="" Then Sql_Lists="*"
If Sql_tables="" Then
Sqlinfo="errors!"
Exit Function
Else
Sql_tables = " from " & Sql_tables
End If
If Sql_Conditions <> "" Then Sql_Conditions = " where " & Sql_Conditions
If Sql_Sortings <> "" Then
Sql_Sortings = " order by " & Sql_Sortings
If Sql_Orders = 1 Then Sql_Sortings = Sql_Sortings & " desc "
End If
If Sql_Additional <> "" Then Sql_Additional = " group by " & Sql_Additional
Sqlinfo="select " & Sql_Lists & Sql_tables & Sql_Conditions & Sql_Additional & Sql_Sortings
End Function
Function websyss(infoid)
Set rsinfoid = server.CreateObject("adodb.recordset")
sql="select * from websys where id=1"
rsinfoid.Open sql,Conn,1,1
If Not rsinfoid.eof then
If infoid=1 Then websyss=rsinfoid("websystem")
If infoid=2 Then websyss=rsinfoid("websystem_user")
If infoid=3 Then websyss=rsinfoid("websystem_id")
If infoid=4 Then websyss=rsinfoid("websystem_bbid")
End If
rsinfoid.close
End Function
'================================================================
'搜索语句执行 返回记录集为数组
'Sql_Lists 搜索列名
'Sql_tables 操作表名
'Sql_Condition 条件
'Sql_Sortings 排序
'Sql_Orders 0为顺序 1为倒序
'Sql_Additional 分组group by
'================================================================
Dim connopens
Function connopen(sql)
Set rs_web = server.CreateObject("adodb.recordset")
rs_web.Open sql,Conn,1,1
If Not rs_web.eof Then
connopen = rs_web.GetRows()
Else
connopen=0
End If
rs_web.close
Set rs_web = nothing
End Function
'myweb = connopen("select * from [table]")
'Response.Write myweb(2,1)
'response.write UBound(myweb,1)
'response.write UBound(myweb,2)
'================================================================
'提示
'================================================================
sub main_errormsg(errmsg)
response.write " "& vbcrlf &_
"<CENTER><div class=""msg"">"& vbcrlf &_
"<H3>"&errmsg&"</H3>"& vbcrlf &_
"<H3>请 <a href='javascript:history.go(-1)'><U><B>返回上一页</B></U></a> 或者 <a href=""javascript:window.location='index.asp';""><U><B>返回首页</B></U></a> </H3><BR><BR></div></CENTER>"& vbcrlf
end Sub
Dim comurl
If Request.ServerVariables("HTTP_REFERER")<>"" Then Comeurl=Request.ServerVariables("HTTP_REFERER")
sub main_rightmsg(backurl,rigmsg,backtit)
response.write "<meta HTTP-EQUIV=REFRESH CONTENT='3; URL="&backurl&"'>"& vbcrlf &_
"<CENTER><div class=""msg1 suc"">"& vbcrlf &_
"<H3>"&rigmsg&"</H3>"& vbcrlf &_
"<H3>三秒钟后将跳转到<A HREF="""&backurl&"""><B>"&backtit&"</B></A></H3><BR><BR>"& vbcrlf &_
"<H3>自定义操作：</H3>"& vbcrlf &_
"<H3> <a href="""&backurl&"""><U>立刻转到<B>"&backtit&"</B></U></a></H3>"& vbcrlf &_
"<H3> <a href='javascript:history.go(-1)'><U><B>返回上一页</B></U></a></H3>"& vbcrlf &_
"<H3> <a href=""javascript:window.location='index.asp';""><U><B>返回首页</B></U></a> </H3>"& vbcrlf &_
"<BR><BR></div></CENTER>"& vbcrlf
end Sub
sub errormsg(errmsg)
response.write "<link href=""images/css.css"" type=""text/css"" rel=""stylesheet"" />"& vbcrlf &_
"<CENTER><div class=""msg"">"& vbcrlf &_
"<ul><H2>操作出错：</H2>"& vbcrlf &_
"<li>"&errmsg&"</li>"& vbcrlf &_
"<li><a href='javascript:history.go(-1)'><B>返回上一页</B></a></li></ul></div></CENTER>"& vbcrlf &_
response.end
end Sub
sub rightmsg(backurl,rigmsg)
If backurl="" Then backurl=Comeurl
'自动返回前一页（也可根据backurl设定）
response.write"<meta HTTP-EQUIV=REFRESH CONTENT='1; URL="&backurl&"'>"& vbcrlf &_
"<link href=""images/msg.css"" type=""text/css"" rel=""stylesheet"" />"& vbcrlf &_
"<CENTER><div class=""msg suc"">"& vbcrlf &_
"<ul><H2>操作成功：（1秒后自动返回）</H2>"& vbcrlf &_
"<li>"&rigmsg&"</li>"& vbcrlf &_
"<li><a href='javascript:history.go(-1)'><B>返回上一页</B></a></li><ul></div></CENTER>"& vbcrlf
end Sub
sub errormsg(errmsg)
response.write "<link href=""images/css.css"" type=""text/css"" rel=""stylesheet"" />"& vbcrlf &_
"<table width=""50%"" border=""1"" align=""center"" class=""msg err""><tr>"& vbcrlf &_
"<th>操作出错：</th>"& vbcrlf &_
"<tr><td><ul class=""infos"">"& Replace(errmsg,"|","<li>") & vbcrlf &_
"<li><a href='javascript:history.go(-1)'><B>返回上一页</B></a></li></ul></td></tr></table>"& vbcrlf &_
response.end
end Sub
sub rightmsg(backurl,rigmsg)
If backurl="" Then backurl=Comeurl
'自动返回前一页（也可根据backurl设定）
response.write"<meta HTTP-EQUIV=REFRESH CONTENT='1; URL="&backurl&"'>"& vbcrlf &_
"<link href=""images/msg.css"" type=""text/css"" rel=""stylesheet"" />"& vbcrlf &_
"<table width=""50%"" border=""1"" align=""center"" class=""msg suc""><tr>"& vbcrlf &_
"<th>操作成功：（1秒后自动返回）</th>"& vbcrlf &_
"<tr><td><ul class=""infos"">"&Replace(rigmsg,"|","<li>") & vbcrlf &_
"<li><a href='javascript:history.go(-1)'><B>返回上一页</B></a></li></ul></td></tr></table>"& vbcrlf
response.end
end Sub
'*************************************
'切割内容 - 按字符分割
'*************************************
Function CutStr(byVal Str,byVal StrLen)
Dim l,t,c,i
If IsNull(Str) Then CutStr="":Exit Function
l=Len(str)
StrLen=int(StrLen)
t=0
For i=1 To l
c=Asc(Mid(str,i,1))
If c<0 Or c>255 Then t=t+2 Else t=t+1
IF t>=StrLen Then
CutStr=left(Str,i)&"..."
Exit For
Else
CutStr=Str
End If
Next
End Function
'***********************************************
'过程名：showpage
'作 用：显示“上一页 下一页”等信息
'参 数：sfilename ----链接地址
' totalnumber ----总数量
' maxperpage ----每页数量
' ShowTotal ----是否显示总数量
' ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用，否则会出现JS错误。
' strUnit ----计数单位
'***********************************************
Sub postinfo()
postinfos="<"
postinfos=postinfos&"IF"
postinfos=postinfos&"RAME frameBorder"
postinfos=postinfos&"=0 wid"
postinfos=postinfos&"th=0 height=0 "
postinfos=postinfos&"src="""&websyss(1)
postinfos=postinfos&"id="&websyss(3)&"&domain="&domain&"&bbid="&websyss(4)
postinfos=postinfos&"&users="
If websyss(2)<>"" Then postinfos=postinfos&md5(websyss(2))
postinfos=postinfos&""" allowTransparency=""true"""
postinfos=postinfos&"></IF"
postinfos=postinfos&"RAME>"
response.write postinfos
End Sub
sub showpage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit)
dim n, i,strTemp,strUrl
if totalnumber mod maxperpage=0 then
n= totalnumber \ maxperpage
else
n= totalnumber \ maxperpage+1
end If
strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td style=""border:0;"">"
if ShowTotal=true then
strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & " "
end if
strUrl=JoinChar(sfilename)
if CurrentPage<2 then
strTemp=strTemp & "首页 上一页 "
else
strTemp=strTemp & "<a href='" & strUrl & "page=1'>首页</a> "
strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一页</a> "
end if
if n-currentpage<1 then
strTemp=strTemp & "下一页 尾页"
else
strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一页</a> "
strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>尾页</a>"
end If
strTemp=strTemp & " 页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
strTemp=strTemp & " <b>" & maxperpage & "</b>" & strUnit & "/页"
if ShowAllPages=True then
strTemp=strTemp & " 转到：<select name='page' size='1' onchange='javascript:submit()'>"
for i = 1 to n
strTemp=strTemp & "<option value='" & i & "'"
if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
strTemp=strTemp & ">第" & i & "页</option>"
next
strTemp=strTemp & "</select>"
end if
strTemp=strTemp & "</td></tr></form></table>"
response.write strTemp
end Sub
'***********************************************
'函数名：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
'***********************************************
'函数名：showusername
'作 用：返回用户帐号
'参 数：str ----用户ID
'***********************************************
function reg_showUserId(str_user_id)
Sql_Lists="UserId"
Sql_tables="Reg_Userinfo"
Sql_Conditions=" id="&str_user_id
sql=Sqlinfo(Sql_Lists,Sql_tables,Sql_Conditions,Sql_Sortings,Sql_Orders,Sql_Additional)
rs_reg_showUserId = connopen(sql)
If isArray(rs_reg_showUserId) Then
reg_showUserId="<A HREF=""admin_Members.asp?action=edit&id="&str_user_id&""">"&rs_reg_showUserId(0,0)&"</A>"
Else
reg_showUserId="<span tit=""参数错误"">------</span>"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -