inc_functions.asp
来自「实现一个用JSP、Servlet技术实现的小型物流网站系统。实现功能如下：管理员」· ASP 代码 · 共 820 行 · 第 1/2 页
ASP
820 行
Function CheckIP(sIP)
sIP=Trim(sIP)
sIP=Replace(sIP,".",",")
sIP=ChkIDs(sIP)
If sIP<>"" Then sIP=Replace(sIP,",",".")
CheckIP=sIP
End Function
Function ChkIDs(byval sIDs)
Dim aIDs,i,sReturn
sIDs=Trim(sIDs)
If Len(sIDs)=0 Then Exit Function
aIDs=Split(sIDs,",")
For i=0 To Ubound(aIDs)
'发现任意不符合的字符，直接跳出
If Not IsNumeric(aIDs(i)) Then
Exit Function
Else
sReturn=sReturn & "," & Int(aIDs(i))
End If
Next
If Left(sReturn,1)="," Then sReturn=Right(sReturn,Len(sReturn)-1)
ChkIDs=sReturn
sReturn=""
End Function
Function FilterIDs(byval strIDs)
Dim arrIDs,i,strReturn
strIDs=Trim(strIDs)
If Len(strIDs)=0 Then Exit Function
arrIDs=Split(strIDs,",")
For i=0 To Ubound(arrIds)
If IsNumeric(arrIDs(i)) Then
strReturn=strReturn & "," & Int(arrIDs(i))
End If
Next
If Left(strReturn,1)="," Then strReturn=Right(strReturn,Len(strReturn)-1)
FilterIDs=strReturn
End Function
Function RndPassword(myLength)
Const minLength = 6
Const maxLength = 12
Randomize
Dim X, Y, strPW
If myLength = 0 Then
Randomize
myLength = Int((maxLength * Rnd) + minLength)
End If
For X = 1 To myLength
Y = Int((3 * Rnd) + 1) '(1) Numeric, (2) Uppercase, (3) Lowercase
Select Case Y
Case 1
'Numeric character
Randomize
strPW = strPW & CHR(Int((9 * Rnd) + 48))
Case 2
'Uppercase character
Randomize
strPW = strPW & CHR(Int((25 * Rnd) + 65))
Case 3
'Lowercase character
Randomize
strPW = strPW & CHR(Int((25 * Rnd) + 97))
End Select
Next
RndPassword = strPW '& Int(rnd*timer)
End Function
'将时间解析成字串
'0:天;1:时;2:分;3:秒
Function GetDateCode(sMode)
Dim sReturn
sReturn=Year(Date) & Right("0" & Month(Date),2) & Right("0" & Day(Date),2)
Select Case sMode
Case "1"
sReturn=sReturn & Right("0" & Hour(Now),2)
Case "2"
sReturn=sReturn & Right("0" & Hour(Now),2) & Right("0" & Minute(Now),2)
Case "3"
sReturn=sReturn & Right("0" & Hour(Now),2) & Right("0" & Minute(Now),2) & Right("0" & Second(Now),2)
End Select
GetDateCode=sReturn
End Function
'将字串分解为时间
Function DeDateCode(sDateCode)
Dim iLen,sReturn
iLen=Len(sDateCode)
Select Case iLen
Case 8
sReturn=Left(sDateCode,4) & "-" & Mid(sDateCode,5,2) & "-" & Right(sDateCode,2)
Case 10
sReturn=Left(sDateCode,4) & "-" & Mid(sDateCode,5,2) & "-" & Mid(sDateCode,7,2) & " " & Right(sDateCode,2)& ":00:00"
Case 12
sReturn=Left(sDateCode,4) & "-" & Mid(sDateCode,5,2) & "-" & Mid(sDateCode,7,2) & " " & Mid(sDateCode,9,2) & ":" & Right(sDateCode,2)& ":00"
Case 14
sReturn=Left(sDateCode,4) & "-" & Mid(sDateCode,5,2) & "-" & Mid(sDateCode,7,2) & " " & Mid(sDateCode,9,2) & ":" & Mid(sDateCode,11,2) & ":" & Right(sDateCode,2)
End Select
If Not IsDate(sReturn) Then sReturn=""
DeDateCode=sReturn
End Function
Sub SystemState()
If Application(cache_name_user&"_systemstate")="stop" Then
If Session("adminname")="" Then
If Right(LCase(Request.ServerVariables("SCRIPT_NAME")),16)<>"/admin_login.asp" Then
%>
<style type="text/css">
.border
{
border: 1px dashed #000066;
}
.tdbg{
background:#EEEEEE;
line-height: 120%;
font: normal 14px "TArial", "Helvetica", "sans-serif";
}
.topbg
{
background:#6699cc;
color: #FFFFFF;
font: normal 14px "TArial", "Helvetica", "sans-serif";
text-align: center;
}
.bgcolor {
background-color: #BFC1AE;
}
</style>
<p> </p>
<table width="300" border="0" align=center cellpadding="2" cellspacing="1" bgcolor="#FFFFFF" class="border">
<tr align="center">
<td height=25 colspan=2 class="topbg"><strong>系统暂时关闭:</strong></td>
</tr>
<tr>
<td class="tdbg">
<%
If Application(cache_name_user&"_systemnote")<>"" Then
Response.Write Application(cache_name_user&"_systemnote")
Else
Response.Write "请稍后访问，谢谢。"
End If
%>
</td>
</tr>
</table>
<%
Response.End
End If
End If
End If
End Sub
Function GetGUID()
Dim sRet,obj
Set obj=Server.CreateObject("Scriptlet.Typelib")
sRet= Mid(LCase(Replace(obj.Guid,"-","")),2,32)
'Response.Write i &":" & sReturn & "<br>"
Set obj=Nothing
GetGUID=sRet
End Function
Function PageBar(total,perpage,current,filename,seed,bShow)
'startPage:循环开始/endPage:循环结束/totalPage:总页数
'处理URL中的空格
Dim sRet,i
sRet=""
filename=Replace(filename," ","%20")
Dim startPage,endPage,totalPage
sRet= "<form name=jumpPage mothod=post action=>"
sRet= sRet & "<font class=tcat2>共"&total&"条 "&"每页"&perpage&"条 "
If total mod perPage=0 Then
totalPage=total/perPage
Else
totalPage=INT(total/perpage)+1
ENd If
If totalPage<=10 Then
startPage=1
Else
If current-seed >0 Then
startPage=current-seed
Else
startPage=1
End If
End If
If totalPage<=10 Then
endPage=totalPage
Else
If (current+seed)<totalPage Then
endPage=current+seed
Else
endPage=totalPage
End If
End If
if current<seed then
if totalPage>10 THen
endPage=10
End If
End if
sRet= sRet & "第"¤t&"页/共" & totalPage&"页, <a href="& filename&"1>第一页</a> "
if current=1 and CLNG(current)<>CLNG(totalPage)then
sRet= sRet & " 上一页 <a href="& filename&""¤t+1&">下一页</a>"
elseif CLNG(current)>1 then
'Response.Write Typename(current)
If CLNG(current)< CLNG(totalPage) Then
sRet= sRet & " <a href="& filename&""¤t-1&">上一页</a> <a href="& filename&""¤t+1&">下一页</a>"
elseif CLNG(current)=CLNG(totalPage) then
sRet= sRet & " <a href="& filename&""¤t-1&">上一页</a> 下一页"
end if
else
sRet= sRet & " 上一页 下一页"
End If
sRet= sRet & " <a href="& filename&totalPage&">最末页</a>"
sRet= sRet & "<input type=hidden name=wheretogo value=go> "
'Response.write "<input type=hidden name=wherefile value="&filename&">"
sRet= sRet & " 跳转到<input name=currentPage class=border1px size=5>页 <input type=button value=GO class=border1px onclick='jump()'> "
'Response.write " <BR>"
If bShow Then
For i=startPage to endPage
if i=cint(current) then
sRet= sRet & "<b>"¤t&"</b> "
Else
sRet= sRet & "<a href="&filename&i&">"&i&"</a> "
End If
Next
End If
sRet= sRet & "</font>"
sRet= sRet & "</form>"
sRet= sRet & "<script language=javascript>"&chr(13)
sRet= sRet & "function jump(){"&chr(13)
sRet= sRet & "window.location.href='"& filename & "'+document.jumpPage.currentPage.value;"&chr(13)
sRet= sRet & "}"&chr(13)
sRet= sRet & "</script>"&chr(13)
PageBar=sRet
sRet=""
End Function
function PageBarNum(total,perpage,current,filename)
dim sRet,pageListCount,i,className
pageListCount=10
If total mod perPage=0 Then
total=total/perPage
Else
total=INT(total/perpage)+1
ENd If
'response.Write(total)
'response.End()
if total>0 then
dim startNum
startNum=int((current-1)/pageListCount)*pageListCount+1
'公式：int((n-1)/col)*col+1 n给定的参数 col每行显示几个数字 从1开始，顺序排
if current<>1 then
sRet="<span class='inactivePage'><a href='"&filename&"1' alt='第一页'>|<</a></span>"
end if
if startNum-pageListCount>0 then
sRet=sRet&"<span class='inactivePage'><a href='"&filename&""&(startNum-pageListCount)&" alt='前"&pageListCount&"页'><<</a></span>"
end if
for i=startNum to startNum+pageListCount-1
if i=current then
className="activePage"
else
className="inactivePage"
end if
sRet=sRet&"<span class='"&className&"'><a href='"&filename&i&"'>"&i&"</a></span>"
if i>=total then
exit for
end if
Next
if startNum+pageListCount<=total then
sRet=sRet&"<span class='inactivePage'><a href='"&filename&(startNum+pageListCount)&"' alt='后"&pageListCount&"页'>>></a></span>"
end if
if current<>total then
sRet=sRet&"<span class='inactivePage'><a href='"&filename&total&"' alt='最后一页'>>|</a></span>"
end if
END IF
PageBarNum=sRet
end function
Function MakeMiniPageBar(iAll,iPer,iThis,sFileName)
Dim sRet,i,iPages,sSeleted
sRet=""
sFileName=Replace(sFileName," ","%20")
sRet= "<form name=jumpPage mothod=post action=>"
sRet= sRet & "共"&iAll&"条,转到 "
If iThis="" Or iThis="0" Then iThis=1
If iAll mod iPer=0 Then
iPages=iAll/iPer
Else
iPages=INT(iAll/iPer)+1
End If
sRet= sRet & "<select name=""currentPage"" onchange=""jump()"">"
For i=1 to iPages
If i=iThis Then
sSeleted=" Selected"
Else
sSeleted=" "
End If
sRet= sRet & "<option value=""" & i & """" & sSeleted & ">" & i & "/" & iPages & "</option>"
Next
sRet= sRet & "</select></form>"
sRet= sRet & "<script language=javascript>"&chr(13)
sRet= sRet & "function jump(){"&chr(13)
sRet= sRet & "window.location.href='"& sFileName & "'+document.jumpPage.currentPage.value;"&chr(13)
sRet= sRet & "}"&chr(13)
sRet= sRet & "</script>"&chr(13)
MakeMiniPageBar=sRet
sRet=""
End Function
'处理用户及群组头像(sType,1-用户;2-群组)
Function ProIco(byval sIco,byval sType)
If IsNull(sIco) Or IsEmpty(sIco) Then sIco=""
sIco=Trim(sIco)
If sIco="" Then
If sType="1" Then
sIco="images/ico_default.gif"
ElseIf sType="2" Then
sIco="images/default_groupico.gif"
ElseIf sType="3" Then
sIco="images/nopic.gIf"
End If
End If
If Left(LCase(sico),7)<>"http://" Then sico=blogurl & sico
ProIco=sico
End Function
'处理样式表，将样式表纳入到<head></head>节
'在系统自定义的Head节增加一个{OB_STYLE}标签
'将提取出的Style填充到该节
'用于用户界面/系统页面的输出
Function OB_PickUpCss(byref sContent)
Dim oRegExp,sRet,Match,Matches
Set oRegExp = New Regexp
oRegExp.IgnoreCase = True
oRegExp.Global = True
oRegExp.Pattern = "<link.+?>"
Set Matches =oRegExp.Execute(sContent)
For Each Match in Matches
sRet = sRet & Match.Value & Vbcrlf
Next
sContent=oRegExp.Replace(sContent,"")
oRegExp.Pattern = "\<style(.[^\[]*)\/style\>"
Set Matches =oRegExp.Execute(sContent)
For Each Match in Matches
sRet = sRet & Match.Value & Vbcrlf
Next
sContent=oRegExp.Replace(sContent,"")
'切掉这个页面上的<body标签>
'oRegExp.Pattern = "<body>"
'sContent =oRegExp.Replace(sContent,"")
Set oRegExp=Nothing
OB_PickUpCss=sRet
End Function
'依据OB_PickUpCss函数进行再处理
'将CSS提取后放到页面的最上部
Function OB_RePutCss(sContent)
Dim sCss
sCss=OB_PickUpCss(sContent)
OB_RePutCss=sCss & Vbcrlf & sContent
End Function
'获取指定分类ID的分类名
Function GetsubName(sid, str)
On Error Resume Next
'Response.Write str & "aaaaaaaaaaaaaaaaaaaaaaaaa<br>"
Dim tmp1, tmp2,a1,a2,i
If sid = "" Or IsNull(sid) Or sid=0 Then
getsubname = "未分类"
Exit Function
End if
sid = Int(sid)
'Response.Write sid & "<br>" & str
'Response.End
str=replace(str,"!!??((","##))==")
'Response.Write str
'Response.End
a1=Split(str,"##))==")
For i=0 To Ubound(a1)-1
If i Mod 2=0 Then
If sid=Int(a1(i)) Then
GetsubName=a1(i+1)
Exit Function
End If
End If
Next
getsubname = "未分类"
End Function
%>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?