📄 function.asp
字号:
<%Function shownav
dim nav_arr(1,10),i
nav_arr(0,0)="上传文件"
nav_arr(1,0)="music_showordersong.asp"
nav_arr(0,1)="音乐地带"
nav_arr(1,1)="music.asp"
'nav_arr(0,2)="网络五子棋"
'nav_arr(1,2)="netwzq/wzq.asp"
'nav_arr(0,3)="单机五子棋"
'nav_arr(1,3)="localwzq/wzq.asp"
'nav_arr(0,4)="棋管中心"
'nav_arr(1,4)="netgame/game.asp"
'nav_arr(0,5)="许愿池"
'nav_arr(1,5)="wish/wish.asp"
For i=0 to Ubound(nav_arr,2)
If Isempty(nav_arr(0,i)) Then Exit For
Response.write " <a href='"&const_txl_HomeUrl&""&nav_arr(1,i)&"' title='"&nav_arr(0,i)&"' target=_blank>"&nav_arr(0,i)&"</a> |"
Next
End Function
Function Music_type(typeid)
Dim rs
set rs=Server.CreateObject("Adodb.Recordset")
rs.open "select * from videotype where typeid="&typeid,conn,1
IF rs.eof then
'exit sub
end if
Response.Write rs("type")
End Function
Function htmlEncode(str)
If len(str)>0 Then
htmlEncode=Replace(Replace(Replace(str,">",">"),"<","<"),"""",""")
Else
htmlEncode=str
End If
End Function
Function HtmlEncode_walk(str)
If Trim(Str)="" Or IsNull(str) Then Exit Function
str=Replace(str,">",">")
str=Replace(str,"<","<")
str=Replace(str,Chr(32)," ")
str=Replace(str,Chr(9)," ")
str=Replace(str,Chr(34),""")
str=Replace(str,Chr(39),"'")
str=Replace(str,Chr(13),"")
str=Replace(str,Chr(10) & Chr(10), "<p></p>")
str=Replace(str,Chr(10),"<br>")
HtmlEncode_walk=str
End Function
Rem 多功能分页函数
Rem 参数说明,(页面数,记录数,当前页,页大小,连接,跨越度)
Function ShowPage(ByRef PageCount,RecordCount,CurrentPage,PageSize,LinkFile,displaypagenum)
Dim Retval,J,StartPage,EndPage
If (RecordCount Mod PageSize)=0 Then
PageCount=RecordCount \ PageSize
Else
PageCount=RecordCount \ PageSize+1
End If
If PageCount=0 Then PageCount=1
If CurrentPage="" Then CurrentPage=1 else CurrentPage=CInt(CurrentPage)
Retval=Retval & "<table width='100%' border='0' cellspacing='0' cellpadding='0'>"
Retval=Retval & "<tr>"
Retval=Retval & "<td height='20'>"
If CurrentPage=1 Then
Retval=Retval & "<font style='color:#999999'>首页</font> | <font style='color:#999999'>前页</font> | "
Else
Retval=Retval & "<a href='" & LinkFile & "Page=1' style='color:#000000'>首页</a> | <a href='" & LinkFile & "Page=" & CurrentPage - 1 & "' style='color:#000000'>前页</a> | "
End If
If CurrentPage=PageCount Then
Retval=Retval & "<font style='color:#999999' style='color:#000000'>后页</font> | <font style='color:#999999'>末页</font>"
Else
Retval=Retval & "<a href='" & LinkFile & "Page=" & CurrentPage + 1 & "' style='color:#000000'>后页</a> | <a href='" & LinkFile & "Page=" & PageCount & "' style='color:#000000'>末页</a>"
End if
If RecordCount>0 Then
Retval=Retval & " | <b>"&CurrentPage&"</b>页/<b>"&CInt(PageCount)&"</b>页 | 共<b>"&RecordCount&"</b>条记录"
End If
Retval=Retval & "<td align='right'>"
StartPage = Page-displaypagenum
EndPage = Page+displaypagenum
If StartPage<=0 Then
StartPage=1
ElseIf StartPage>1 Then
Retval=Retval & " <a href='" & LinkFile & "Page=1' style='font-family:webdings' title='首页'>9</a>"
Retval=Retval & " ... "
End If
If EndPage>PageCount Then EndPage=PageCount
For J = StartPage to EndPage
If J = Page Then
Retval = Retval & " <font color=#999999>" & J & "</font>"
Else
Retval = Retval & " <a href='" & LinkFile & "Page=" & J & "' style='color:#000000'>" & J & "</a>"
End If
Next
If EndPage < PageCount Then Retval= Retval & " ... <a href='" & LinkFile & "Page=" & PageCount & "' style='font-family:webdings;color:#000000'' title='末页'>:</a>"
Retval=Retval & "</td>"
Retval=Retval & "</tr>"
Retval=Retval & "</table>"
ShowPage=Retval
End Function
Function showuserpic(picurl,picwidth,picheight)
dim width_xx,height_xx
If picwidth>120 Then
width_xx="width=120"
Elseif picwidth>0 then
width_xx="width="&picwidth
ElseIf picwidth=0 Then
width_xx=""
End If
If picheight>Int(Split(const_Faceheight,"|")(1)) Then
height_xx="height="&Split(const_FaceWidth,"|")(1)
ElseIf picheight>0 Then
height_xx="height="&picheight
ElseIf picheight=0 Then
height_xx=""
End If
IF lcase(Left(picurl,5))="http:" then
Response.Write "<img name='faceimg' border=0 src='" + picurl + "'" & width_xx & " " & height_xx & " onload=""javascript:if(this.width>120) this.width=120"">"
ElseIf picurl<>"" and (not isnull(picurl)) Then
Response.Write("<img name='faceimg' border=0 src='"&const_txl_HomeUrl&picurl + "' " & width_xx & " " & height_xx & " onload=""javascript:if(this.width>120) this.width=120"">")
End If
End Function
'**************************************************
'函数名:gotTopic
'作 用:截字符串,汉字一个算两个字符,英文算一个字符
'参 数:str ----原字符串
' strlen ----截取长度
'返回值:截取后的字符串
'***************************************************
function walkgotTopic(str,strlen)
if str="" then
walkgotTopic=""
exit function
end if
dim l,t,c, i
str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")
l=len(str)
t=0
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
if t>=strlen then
walkgotTopic=left(str,i) & "…"
exit for
else
walkgotTopic=str
end if
next
walkgotTopic=replace(replace(replace(replace(walkgotTopic," "," "),chr(34),"""),">",">"),"<","<")
end function
function printerror(errtitle,errstr,width)
Response.write "<br><table width='"&width&"' border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"" bgcolor=""#666666"">"&Vbcrlf
Response.write " <tr>"&Vbcrlf
Response.write " <td height=20 class='title'><font color='#FFFFFF'><b>"&errtitle&"</b></font></td>"&Vbcrlf
Response.write " </tr>"&Vbcrlf
Response.write " <tr>" &Vbcrlf
Response.write " <td bgcolor=""#FFFFFF"" class='content' style='line-height:1.8;'><b>产生错误的可能原因:</b><br>"&errstr&"</td>"&Vbcrlf
Response.write " </tr>"&Vbcrlf
Response.write " <tr>" &Vbcrlf
Response.write " <td align=""center"" height=30 bgcolor=""#FFFFFF""><< <a href=""javascript:history.back()"">返回上一页</a></td>"&Vbcrlf
Response.write " </tr>"&Vbcrlf
Response.write "</table><br>"&Vbcrlf
end function
function printsuc(suctitle,sucstr,width)
Response.write "<br><table width='"&width&"' border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"" bgcolor=""#666666"">"&Vbcrlf
Response.write " <tr>"&Vbcrlf
Response.write " <td height=20 class='title'><font color='#FFFFFF'><b>"&suctitle&"</b></font></td>"&Vbcrlf
Response.write " </tr>"&Vbcrlf
Response.write " <tr>" &Vbcrlf
Response.write " <td bgcolor=""#FFFFFF"" class='content' style='line-height:1.8;'><b>您可以选择以下操作:</b><br><li><a href='"&const_txl_homeurl&"index.asp'>返回首页</a></li>"&sucstr&"</td>"&Vbcrlf
Response.write " </tr>"&Vbcrlf
Response.write " <tr>" &Vbcrlf
Response.write " <td align=""center"" height=30 bgcolor=""#FFFFFF""><< <a href=""javascript:history.back()"">返回上一页</a></td>"&Vbcrlf
Response.write " </tr>"&Vbcrlf
Response.write "</table><br>"&Vbcrlf
end function
Rem 判断外部提交
function outsitesubmit
dim server_v1,server_v2
server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
if mid(server_v1,8,len(server_v2))<>server_v2 then
outsitesubmit=true
end if
end function
Rem 短信发布函数
function sendpermsg(username,towho,title,content,adddate)
on error resume next
dim sql
sql="insert into permsg (username,towho,title,content,adddate) values('"
sql=sql&username&"','"&towho&"','"&title&"','"&content&"','"&now()&"')"
conn.execute sql
if err then
sendpermsg=false
else
sendpermsg=true
end if
end function
Rem 得到系统短信
Function getmsgnum(userid)
Dim rs,Int_num
set rs=Conn.execute("Select Count(*) from permsg where towho='"&userid&"' and isread=0")
Int_num=rs(0)
getmsgnum=Int_num
rs.close
set rs=nothing
End Function
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -