⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 function.asp

📁 WAP网上购物系统源程序,,有兴趣的朋友,一起研究一下..交流经眼
💻 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 "&nbsp;<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,">","&gt;"),"<","&lt;"),"""","&quot;")
	Else
		htmlEncode=str
	End If
End Function


Function HtmlEncode_walk(str)
    If Trim(Str)="" Or IsNull(str) Then Exit Function
    str=Replace(str,">","&gt;")
    str=Replace(str,"<","&lt;")
    str=Replace(str,Chr(32),"&nbsp;")
    str=Replace(str,Chr(9),"&nbsp;")
    str=Replace(str,Chr(34),"&quot;")
    str=Replace(str,Chr(39),"&#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,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<")
	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," ","&nbsp;"),chr(34),"&quot;"),">","&gt;"),"<","&lt;")
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"">&lt;&lt; <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"">&lt;&lt; <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 + -