📄 function.asp
字号:
<%
'================================
'功能：分页组件
'参数：
'================================
function pagination(pagecount,pagesize,page,resultcount)
Dim query, a, x, temp,action
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "page", vbTextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
Response.Write("<form method=get onsubmit=""document.location = '" & action & "?" & temp & "Page='+this.page.value;return false;"">")
if page<=1 then
Response.Write ("[首页] [上一页] ")
else
Response.Write("[<a href=" & action & "?" & temp & "Page=1>首页</a>] ")
Response.Write("[<a href=" & action & "?" & temp & "Page=" & (Page-1) & ">上一页</a>] ")
end if
if page>=pagecount then
Response.Write ("[下一页] [最后页]")
else
Response.Write("[<a href=" & action & "?" & temp & "Page=" & (Page+1) & ">下一页</a>] ")
Response.Write("[<a href=" & action & "?" & temp & "Page=" & pagecount & ">尾页</a>]")
end if
Response.Write("[页次:<font color=red>" & page & "</font>/" & pageCount)
Response.Write("] [共" & resultcount & "条 <font color=red>"& pagesize & "</font>条/页]")
Response.Write(" 转到" & "<input name=page size=2 class='inputs' value=" & page & ">" & "页<input type=submit class='buton' value='Go'>")
End function
%>
<%
'================================
'功能：会员等级说明
'参数：无
'================================
sub userclass()
select case userlevel
case 0
response.write"欢迎你，你还没有<a href='regread.asp'>注册</a>或登录！"
case 1
response.write"欢迎注册用户 <font class='txt04'>"&loginname&"</font> 来到本站！"
case 2
response.write"欢迎普通会员 <font class='txt04'>"&loginname&"</font> 来到本站！"
case 3
response.write"欢迎中级会员 <font class='txt04'>"&loginname&"</font> 来到本站！"
case 4
response.write"欢迎高级会员 <font class='txt04'>"&loginname&"</font> 来到本站！"
case 5
response.write"欢迎特级会员 <font class='txt04'>"&loginname&"</font> 来到本站！"
end select
end sub
%>
<%
'=============================
'功能：检查Email地址合法性
'参数：email----要检查的Email地址
'=============================
function checkEmail(email)
dim names, name, i, c
checkEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
checkEmail = false
exit function
end if
for each name in names
if Len(name) <= 0 then
checkEmail = false
exit function
end if
for i = 1 to Len(name)
c = Lcase(Mid(name, i, 1))
if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
checkEmail = false
exit function
end if
next
if Left(name, 1) = "." or Right(name, 1) = "." then
checkEmail = false
exit function
end if
next
if InStr(names(1), ".") <= 0 then
checkEmail = false
exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
checkEmail = false
exit function
end if
if InStr(email, "..") > 0 then
checkEmail = false
end if
end function
%>
<%
'============================
'功能：显示错误信息
'参数：无
'============================
sub ShowErrMsg()
dim strErr
strErr=strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
strErr=strErr & "<link href='sty_index.css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
strErr=strErr & "<table cellpadding=2 cellspacing=2 border=0 width=400 class='border' align=center>" & vbcrlf
strErr=strErr & " <tr align='center'><td height='20' class='voteshow'>错误信息</td></tr>" & vbcrlf
strErr=strErr & " <tr><td height='100' class='voteshowlist' valign='top'><b>产生错误的可能原因：</b><br>" & errmsg &"</td></tr>" & vbcrlf
strErr=strErr & " <tr align='center'><td class='voteshowdown'>【<a href='RegRead.asp'>注册</a>】 【<a href='index.asp'>返回主页</a>】</td></tr>" & vbcrlf
strErr=strErr & "</table>" & vbcrlf
strErr=strErr & "</body></html>" & vbcrlf
response.write strErr
response.end()
end sub
'===================================
'功能：显示成功信息
'参数：无
'===================================
sub ShowSuccessMsg()
dim strSuccess
strSuccess=strSuccess & "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
strSuccess=strSuccess & "<link href='sty_index.css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
strSuccess=strSuccess & "<table cellpadding='2' cellspacing=2 border=0 width=400 class='border' align=center>" & vbcrlf
strSuccess=strSuccess & " <tr align='center'><td height='20' class='voteshow'><strong>恭喜你！</strong></td></tr>" & vbcrlf
strSuccess=strSuccess & " <tr><td height='100' class='voteshowlist' valign='top'><br>" & SuccessMsg &"</td></tr>" & vbcrlf
strSuccess=strSuccess & " <tr align='center'><td class='voteshowdown'><br>【<a href='javascript:window.close()'>关 闭</a>】</td></tr>" & vbcrlf
strSuccess=strSuccess & "</table>" & vbcrlf
strSuccess=strSuccess & "</body></html>" & vbcrlf
response.write strSuccess
response.end()
end sub
'===================================
'功能：向地址中加入 ? 或 &
'参数：strUrl--------要检查的URL地址
'===================================
function JoinChar(strUrl)
if strUrl="" then
JoinChar=""
exit function
end if
if InStr(strUrl,"?")<len(strUrl) then
if InStr(strUrl,"?")>1 then
JoinChar=strUrl & "&"
else
JoinChar=strUrl & "?"
end if
else
JoinChar=strUrl
end if
end function
'==========================
'功能：文件管理中的分页
'参数：sfilename-------文件名
'totalnumber---------
'maxperpage----------每页显示的文件数
'==========================
sub showpage2(sfilename,totalnumber,maxperpage)
dim n, i,strTemp
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>"
strTemp=strTemp & "共 <b>" & totalnumber & "</b> 个文件，占用 <b>" & TotleSize\1024 & "</b> K "
sfilename=JoinChar(sfilename)
if CurrentPage<2 then
strTemp=strTemp & "首页 上一页 "
else
strTemp=strTemp & "<a href='" & sfilename & "page=1'>首页</a> "
strTemp=strTemp & "<a href='" & sfilename & "page=" & (CurrentPage-1) & "'>上一页</a> "
end if
if n-currentpage<1 then
strTemp=strTemp & "下一页 尾页"
else
strTemp=strTemp & "<a href='" & sfilename & "page=" & (CurrentPage+1) & "'>下一页</a> "
strTemp=strTemp & "<a href='" & sfilename & "page=" & n & "'>尾页</a>"
end if
strTemp=strTemp & " 页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
strTemp=strTemp & " <b>" & maxperpage & "</b>" & "个文件/页"
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>"
strTemp=strTemp & "</td></tr></form></table>"
response.write strTemp
end sub
'===============================================
'功能：字符串长度。汉字算两个字符，英文算一个字符。
'参数：str---------要检查的字符串
'===============================================
function strLength(str)
ON ERROR RESUME NEXT
dim WINNT_CHINESE
WINNT_CHINESE = (len("中国")=2)
if WINNT_CHINESE then
dim l,t,c
dim i
l=len(str)
t=l
for i=1 to l
c=asc(mid(str,i,1))
if c<0 then c=c+65536
if c>255 then
t=t+1
end if
next
strLength=t
else
strLength=len(str)
end if
if err.number<>0 then err.clear
end function
'=============================================
'功能：检查文件扩展名
'参数：fileName--------要检查的文件
'=============================================
function getFileExtName(fileName)
dim pos
pos=instrrev(filename,".")
if pos>0 then
getFileExtName=mid(fileName,pos+1)
else
getFileExtName=""
end if
end function
'=======================================
'功能：检查组件是否已安装
'参数：strClassString-----------检查FSO是否安装
'=======================================
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
'=================================================
'功能：采用自动分页方式显示文章具体的内容
'参数：无
'=================================================
sub autopage()'by freepowper365
dim strContent,CurrentPage
dim ContentLen,pages,i,lngBound
dim BeginPoint,EndPoint
articleid=rsread("articleid")
strContent=rsread("content")
ContentLen=len(strContent)
CurrentPage=trim(request("ArticlePage"))
if ContentLen<=int(ArticleCount) then
response.write strContent
response.write "</p><p align='center'><font color='red'><b>[1]</b></font></p>"
else
if CurrentPage="" then
CurrentPage=1
else
CurrentPage=Cint(CurrentPage)
end if
pages=ContentLen\int(ArticleCount)
if int(ArticleCount)*pages<ContentLen then
pages=pages+1
end if
lngBound=ContentLen '最大误差范围
if CurrentPage<1 then CurrentPage=1
if CurrentPage>pages then CurrentPage=pages
dim lngTemp
dim lngTemp1,lngTemp1_1,lngTemp1_2,lngTemp1_1_1,lngTemp1_1_2,lngTemp1_1_3,lngTemp1_2_1,lngTemp1_2_2,lngTemp1_2_3
dim lngTemp2,lngTemp2_1,lngTemp2_2,lngTemp2_1_1,lngTemp2_1_2,lngTemp2_2_1,lngTemp2_2_2
dim lngTemp3,lngTemp3_1,lngTemp3_2,lngTemp3_1_1,lngTemp3_1_2,lngTemp3_2_1,lngTemp3_2_2
dim lngTemp4,lngTemp4_1,lngTemp4_2,lngTemp4_1_1,lngTemp4_1_2,lngTemp4_2_1,lngTemp4_2_2
dim lngTemp5,lngTemp5_1,lngTemp5_2
dim lngTemp6,lngTemp6_1,lngTemp6_2
if CurrentPage=1 then
BeginPoint=1
else
BeginPoint=int(ArticleCount)*(CurrentPage-1)+1
lngTemp1_1_1=instr(BeginPoint,strContent,"</table>",1)
lngTemp1_1_2=instr(BeginPoint,strContent,"</TABLE>",1)
lngTemp1_1_3=instr(BeginPoint,strContent,"</Table>",1)
if lngTemp1_1_1>0 then
lngTemp1_1=lngTemp1_1_1
elseif lngTemp1_1_2>0 then
lngTemp1_1=lngTemp1_1_2
elseif lngTemp1_1_3>0 then
lngTemp1_1=lngTemp1_1_3
else
lngTemp1_1=0
end if
lngTemp1_2_1=instr(BeginPoint,strContent,"<table",1)
lngTemp1_2_2=instr(BeginPoint,strContent,"<TABLE",1)
lngTemp1_2_3=instr(BeginPoint,strContent,"<Table",1)
if lngTemp1_2_1>0 then
lngTemp1_2=lngTemp1_2_1
elseif lngTemp1_2_2>0 then
lngTemp1_2=lngTemp1_2_2
elseif lngTemp1_2_3>0 then
lngTemp1_2=lngTemp1_2_3
else
lngTemp1_2=0
end if
if lngTemp1_1=0 and lngTemp1_2=0 then
lngTemp1=BeginPoint
else
if lngTemp1_1>lngTemp1_2 then
lngtemp1=lngTemp1_2
else
lngTemp1=lngTemp1_1+8
end if
end if
lngTemp2_1_1=instr(BeginPoint,strContent,"</p>",1)
lngTemp2_1_2=instr(BeginPoint,strContent,"</P>",1)
if lngTemp2_1_1>0 then
lngTemp2_1=lngTemp2_1_1
elseif lngTemp2_1_2>0 then
lngTemp2_1=lngTemp2_1_2
else
lngTemp2_1=0
end if
lngTemp2_2_1=instr(BeginPoint,strContent,"<p",1)
lngTemp2_2_2=instr(BeginPoint,strContent,"<P",1)
if lngTemp2_2_1>0 then
lngTemp2_2=lngTemp2_2_1
elseif lngTemp2_2_2>0 then
lngTemp2_2=lngTemp2_2_2
else
lngTemp2_2=0
end if
if lngTemp2_1=0 and lngTemp2_2=0 then
lngTemp2=BeginPoint
else
if lngTemp2_1>lngTemp2_2 then
lngtemp2=lngTemp2_2
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -