📄 cls_public.asp
字号:
'标题颜色处理函数
'输入参数：
' 1、颜色号
' 2、标题文字
'************************************************
Public Function Add_ArticleColor(ColorCode,Title)
Dim TempStr
If Not IsNumeric(ColorCode) Then
TempStr=Title
Else
Select Case CInt(ColorCode)
Case 1
TempStr="<font color=""#FF0000"">"&Title&"</font>"
Case 2
TempStr="<font color=""#25B825"">"&Title&"</font>"
Case 3
TempStr="<font color=""#0066CC"">"&Title&"</font>"
Case Else
TempStr=Title
End select
End If
Add_ArticleColor=TempStr
End Function
'*******************************************
'显示文章类型函数
'输入参数：
' 1、是否为图片文章
' 2、是否为推荐文章
'*******************************************
Public Function Chk_ArticleType(IsImg,IsTop)
Dim TempStr
If CBool(IsTop) Then
TempStr=TempStr&"<img src="""&SystemFolder&"images/public/article_top.gif"" alt=""推荐文章"" border=0>"
Else
If CBool(IsImg) Then
TempStr=TempStr&"<img src="""&SystemFolder&"images/public/article_img.gif"" alt=""图片文章"" border=0>"
Else
TempStr=TempStr&"<img src="""&SystemFolder&"images/public/article_normal.gif"" alt=""普通文章"" border=0>"
End If
End If
Chk_ArticleType=TempStr
End Function
'****************************************
'检测文章是否为新文章
'输入参数：
' 1、发表时间
'****************************************
Public Function Chk_ArticleTime(PostTime)
If DateDiff("h",PostTime,Now())<=24 Then Chk_ArticleTime=" <img src="""&SystemFolder&"images/public/new.gif"" border=0 align=absmiddle alt=""24小时内新文章"">"
End Function
'**************************************************
'替换文章正文中的内部连接函数
'输入参数：
' 1、文章内容
' 2、文章地址[栏目id]
'**************************************************
Public Function Cov_InsideLink(StrContent,ColumnId)
Dim i
Dim TempArray
Dim WordIndex
TempArray=EA_DBO.Get_InsideLink_ByColumn(ColumnId)
If IsArray(TempArray) Then
For i=0 To UBound(TempArray,2)
WordIndex=InStr(1,StrContent,TempArray(0,i))
If WordIndex>0 Then StrContent=Replace(StrContent,TempArray(0,i),"<a href="""&TempArray(1,i)&""" target=""_blank"" class=""a_link"">"&TempArray(0,i)&"</a>")
Next
End If
Cov_InsideLink=StrContent
End Function
'************************************************
'转换栏目路径函数
'输入参数：
' 1、栏目id
' 2、路径类型
'************************************************
Public Function Cov_ColumnPath(ColumnId,PathType)
If PathType=1 Then
Cov_ColumnPath=SystemFolder&"list.asp?classid="&ColumnId
Else
Cov_ColumnPath=SystemFolder&"articlelist/article_"&ColumnId&"_adddate_desc_1.htm"
End If
End Function
'**************************************************************
'转换文章路径函数
'输入参数：
' 1、文章id
' 2、文章发表时间
' 3、路径类型
'**************************************************************
Public Function Cov_ArticlePath(ArticleId,ArticleTime,PathType)
If PathType=1 Then
Cov_ArticlePath=SystemFolder&"article.asp?articleid="&ArticleId
Else
Cov_ArticlePath=SystemFolder&"articleview/"&FormatDateTime(ArticleTime,2)&"/article_view_"&ArticleId&".htm"
End If
End Function
Public Function Get_NavByColumnCode(sCode)
Dim StepNum
Dim TempStr,TempArray
Dim i
StepNum=Len(sCode)/4
TempArray=EA_DBO.Get_Nav_List(StepNum,sCode)
If IsArray(TempArray) Then
For i=0 To UBound(TempArray,2)
TempStr=TempStr&" -=> <a href="""&Cov_ColumnPath(TempArray(0,i),SysInfo(18))&"""><b>"&TempArray(1,i)&"</b></a>"
Next
End If
Get_NavByColumnCode=TempStr
End Function
'*****************************************
'简单HTML代码过滤函数
'输入参数：
' 1、待过滤字符串
'*****************************************
Public Function Base_HTMLFilter(sInputStr)
If Len(sInputStr)>0 Then
sInputStr=Replace(sInputStr,Chr(13)&Chr(10),vbcrlf)
End If
Base_HTMLFilter=sInputStr
End Function
'*****************************************
'全HTML代码过滤函数
'输入参数：
' 1、待过滤字符串
'*****************************************
Public Function Full_HTMLFilter(sInputStr)
If Len(sInputStr)>0 Then
sInputStr=Replace(sInputStr, ">", ">")
sInputStr=Replace(sInputStr, "<", "<")
sInputStr=Replace(sInputStr, """", """)
sInputStr=Replace(sInputStr, CHR(32), " ")
sInputStr=Replace(sInputStr, CHR(9), " ")
sInputStr=Replace(sInputStr, CHR(34), """)
sInputStr=Replace(sInputStr, CHR(39), "'")
sInputStr=Replace(sInputStr, CHR(13), "")
sInputStr=Replace(sInputStr, CHR(10) & CHR(10), "</P><P> ")
sInputStr=Replace(sInputStr, CHR(10), "<BR>")
sInputStr=BadWords_Filter(sInputStr)
End If
Full_HTMLFilter = sInputStr
End Function
'***************************************
'HTML过滤逆转换函数
'输入参数：
' 1、待转换字符串
'***************************************
Public Function Un_Base_HTMLFilter(sInputStr)
If Len(sInputStr)>0 Then
sInputStr = Replace(sInputStr, "</P><P> ", " ")
sInputStr = Replace(sInputStr, "<BR>", " ")
End If
Un_Base_HTMLFilter = sInputStr
End Function
'***************************************
'HTML过滤逆转换函数
'输入参数：
' 1、待转换字符串
'***************************************
Public Function Un_Full_HTMLFilter(sInputStr)
If Len(sInputStr)>0 Then
sInputStr = Replace(sInputStr, "</P><P> ", CHR(10) & CHR(10))
sInputStr = Replace(sInputStr, "<BR>", CHR(10))
End If
Un_Full_HTMLFilter = sInputStr
End Function
'****************************************
'屏蔽字符过滤函数
'输入参数：
' 1、待过滤内容
'****************************************
Public Function BadWords_Filter(strText)
Dim str_FilterContent
Dim BadWord_Array
Dim Tmp,i,TempArray
TempArray=EA_DBO.Get_System_Info()
If IsArray(TempArray) Then str_FilterContent=TempArray(7,0)
If Not(IsNull(str_FilterContent) Or Not IsNull(strText)) Then
BadWord_Array = Split(str_FilterContent, ";")
For i = 0 To Ubound(BadWord_Array)
Tmp=Split(BadWord_Array(i),"==")
strText = Replace(strText, Tmp(0), Tmp(1))
Next
End If
BadWords_Filter = strText
End Function
Public function DealJsText(Str)
if not isnull(Str) then
Dim re,po,ii
Str = Replace(Str, CHR(9), " ")
Str = Replace(Str, CHR(39), "'")
Str = Replace(Str, CHR(13), "")
Str = Replace(Str, CHR(10) & CHR(13), "</P><P> ")
Str = Replace(Str, CHR(10), "")
Str = Replace(Str, "‘", "'")
Str = Replace(Str, "’", "'")
'网友冷情圣郎提供
Str = Replace(Str, "\", "\\")
Str = Replace(Str, CHR(32), " ")
Str = Replace(Str, CHR(34), "\""")
Str = Replace(Str, CHR(39), "'")
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
po=0
ii=0
re.Pattern="(javascript)"
Str=re.Replace(Str,"<I>javascript</I>")
re.Pattern="(jscript:)"
Str=re.Replace(Str,"<I>jscript:</I>")
re.Pattern="(js:)"
Str=re.Replace(Str,"<I>js:</I>")
re.Pattern="(</SCRIPT>)"
Str=re.Replace(Str,"</script>")
re.Pattern="(<SCRIPT)"
Str=re.Replace(Str,"<script")
DealJsText = Str
End if
end Function
'****************************************************
'检测数据提交间隔时间函数
'输入参数：
' 1、间隔时间
' 2、间隔符
' 3、对照时间
'****************************************************
Public Function Chk_PostTime(iSpace,sSplit,sSourTime)
Dim Flag
Flag=False
If Not IsDate(sSourTime) Then
Flag=False
Else
If DateDiff(sSplit,sSourTime,Now())<iSpace Then
Flag=True
Else
Flag=False
End If
End If
Chk_PostTime=Flag
End Function
'*************************************************************************************
'全功能安全过滤函数
'输入参数：
' 1、请求方式
' 2、请求名
' 3、值类型
' 4、默认值
' 5、过滤类型
'*************************************************************************************
Public Function SafeRequest(Requester,RequestName,RequestType,DefaultValue,FilterType)
Dim TempValue
Select Case Requester
Case 0
TempValue=RequestName
Case 1
TempValue=Request(RequestName)
Case 2
TempValue=Request.Form (RequestName)
Case 3
TempValue=Request.QueryString (RequestName)
Case 4
TempValue=Request.Cookies (RequestName)
End Select
Select Case RequestType
Case 0
If Not IsNumeric(TempValue) Or Len(TempValue)<=0 Then
TempValue=CLng(DefaultValue)
Else
TempValue=CLng(TempValue)
End If
Case 1
Select Case FilterType
Case 0
TempValue=Replace(TempValue,"'","'")
If iDataBaseType>0 Then TempValue=Replace(TempValue,";","；")
TempValue=Replace(TempValue,"select","Ｓelect",1,-1,1)
Case 1
TempValue=Replace(TempValue,"'","'")
Call Base_HTMLFilter(TempValue)
Case 2
TempValue=Replace(TempValue,"'","'")
Call Full_HTMLFilter(TempValue)
End Select
Case 2
If Not IsDate(TempValue) Or Len(TempValue)<=0 Then
TempValue=CDate(DefaultValue)
Else
TempValue=CDate(TempValue)
End If
End Select
SafeRequest=TempValue
End function
'***************************
'获取来访用户IP函数
'***************************
Public Function Get_UserIp()
Dim Ip,Tmp
Dim i,IsErr
IsErr=False
Ip=Request.ServerVariables("REMOTE_ADDR")
If Len(Ip)<=0 Then Ip=Request.ServerVariables("HTTP_X_ForWARDED_For")
If Len(Ip)>15 Then
IsErr=True
Else
Tmp=Split(Ip,".")
If Ubound(Tmp)=3 Then
For i=0 To Ubound(Tmp)
If Len(Tmp(i))>3 Then IsErr=True
Next
Else
IsErr=True
End If
End If
If IsErr Then
Get_UserIp="1.1.1.1"
Else
Get_UserIp=Ip
End If
End Function
'*******************************
'格式化ip字符串函数
'输入参数：
' 1、ip字符串
'*******************************
Public Function FormatIp(IpStr)
Dim Tmp,i
Tmp=Split(IpStr,".")
For i=0 To Ubound(Tmp)
If Len(Tmp(i))<3 Then Tmp(i)=Right("000"&Tmp(i),3)
Next
IpStr=Join(Tmp,",")
FormatIp=Replace(IpStr,",","")
End Function
'************************************************
'统计页总数函数
'输入参数：
' 1、每页记录数
' 2、记录总数
'************************************************
Public Function Stat_Page_Total(PageSize,ReCount)
If ReCount Mod PageSize=0 Then
Stat_Page_Total= CLng(ReCount \ PageSize)
Else
Stat_Page_Total= CLng((ReCount \ PageSize)+1)
End If
End Function
End Class
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -