📄 inc_functions.asp
字号:
'将时间解析成字串
'0:天;1:时;2:分;3:秒
Function GetDateCode(sDate,sMode)
Dim sReturn
If Not IsDate(sDate) Or IsNull(sDate) Then sDate = Now()
sReturn=Year(sDate) & Right("0" & Month(sDate),2) & Right("0" & Day(sDate),2)
select Case sMode
Case "1"
sReturn=sReturn & Right("0" & Hour(sDate),2)
Case "2"
sReturn=sReturn & Right("0" & Hour(sDate),2) & Right("0" & Minute(sDate),2)
Case "3"
sReturn=sReturn & Right("0" & Hour(sDate),2) & Right("0" & Minute(sDate),2) & Right("0" & Second(sDate),2)
End select
GetDateCode=sReturn
End Function
'将字串分解为时间
Function DeDateCode(sDateCode)
If IsDate(sReturn) Then DeDateCode=sDateCode:Exit Function
Dim iLen,sReturn
iLen=Len(sDateCode)
select Case iLen
Case 6
sReturn=Left(sDateCode,4) & "-" & Right(sDateCode,2)
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
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-群组,3-模版,4-相册)
Function ProIco(byval sIco,byval sType)
If IsNull(sIco) Or IsEmpty(sIco) Then sIco=""
sIco=Trim(sIco)
sIco=HTMLEncode(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"
ElseIf sType = "4" Then
sIco="images/photo_default.gif"
End If
End If
If Left(LCase(sico),7)<>"http://" And Left(LCase(sico),1)<>"/" 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
'**************************************************
'函数名：AnsiToUnicode
'作 用：转换为 Unicode 编码
'参 数：str ---- 要转换的字符
'返回值：转换后的字符
'**************************************************
Public Function AnsiToUnicode(ByVal str)
Dim i, j, c, i1, i2, u, fs, f, p
AnsiToUnicode = ""
p = ""
For i = 1 To Len(str)
c = Mid(str, i, 1)
j = AscW(c)
If j < 0 Then
j = j + 65536
End If
If j >= 0 And j <= 128 Then
If p = "c" Then
AnsiToUnicode = " " & AnsiToUnicode
p = "e"
End If
AnsiToUnicode = AnsiToUnicode & c
Else
If p = "e" Then
AnsiToUnicode = AnsiToUnicode & " "
p = "c"
End If
AnsiToUnicode = AnsiToUnicode & ("&#" & j & ";")
End If
Next
End Function
'**************************************************
'函数名：UnicodeToAnsi
'作 用：转换为 Ansi 编码
'参 数：str ---- 要转换的字符
'返回值：转换后的字符
'**************************************************
Function UnicodeToAnsi(ByVal str)
If IsNull(str) or str = "" Then
UnicodeToAnsi = ""
Exit Function
End If
Dim reg,strMatch,strTemp,arrMatches
strTemp = str
Set reg = New RegExp
reg.IgnoreCase = True
reg.Global =False
reg.Pattern = "\&#(\d*);"
Set arrMatches = reg.Execute(str)
For Each strMatch In arrMatches
str = Replace(str,strMatch.Value,chrW(strMatch.SubMatches(0)))
Next
set reg=Nothing
UnicodeToAnsi = str
End Function
'获取指定分类ID的分类名
Function GetsubName(sid, str)
On Error Resume Next
Dim tmp1, tmp2,a1,a2,i
If sid = "" Or IsNull(sid) Or sid=0 Then
getsubname = "——"
Exit Function
End if
str=Replace(str,"!!??((","##))==")
a1=Split(str,"##))==")
For i=0 To Ubound(a1)-1
If i Mod 2=0 Then
If Int(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 + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -