虚位以待(AD)
虚位以待(AD)
首页 > 数据库 > MsSql数据库 > pjblog2的参数第1/2页

pjblog2的参数第1/2页
类别：MsSql数据库   作者：码皇   来源：互联网   点击：

", 1) - intPos) if err then highlight=strContent err clear end if strTemp = strTemp & Mid(strContent, intPos, intTagLength) ,魔客吧
<%
'===============================================================
' Function For PJblog2
' 更新时间: 2006-6-2
'===============================================================

'*************************************
'防止外部提交
'*************************************
function ChkPost()
dim server_v1,server_v2
chkpost=false
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
chkpost=False
else
chkpost=True
end If
end function


'*************************************
'IP过滤
'*************************************
function MatchIP(IP)
on error resume next
MatchIP=false
Dim SIp,SplitIP
for each SIp in FilterIP
SIp=replace(SIp,"*","d*")
SplitIP=split(SIp,".")
Dim re, strMatchs,strIP
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="("&SplitIP(0)&"|)."&"("&SplitIP(1)&"|)."&"("&SplitIP(2)&"|)."&"("&SplitIP(3)&"|)"
Set strMatchs=re.Execute(IP)
strIP=strMatchs(0).SubMatches(0) & "." & strMatchs(0).SubMatches(1)& "." & strMatchs(0).SubMatches(2)& "." & strMatchs(0).SubMatches(3)
if strIP=IP then MatchIP=true:exit function
Set strMatchs=Nothing
Set re=Nothing
next
end function

'*************************************
'获得注册码
'*************************************
Function getcode()
getcode= ""
End Function

'*************************************
'限制上传文件类型
'*************************************
Function IsvalidFile(File_Type)
IsvalidFile = False
Dim GName
For Each GName in UP_FileType
If File_Type = GName Then
IsvalidFile = True
Exit For
End If
Next
End Function


'*************************************
'限制插件名称
'*************************************
Function IsvalidPlugins(Plugins_Name)
dim NoAllowNames,NoAllowName
NoAllowNames="user,bloginfo,calendar,comment,search,links,archive,category,contentlist"
NoAllowName=split(NoAllowNames,",")
IsvalidPlugins = true
Dim GName
Plugins_Name=trim(lcase(Plugins_Name))
For Each GName in NoAllowName
If Plugins_Name = GName Then
IsvalidPlugins = false
Exit For
End If
Next
End Function


'*************************************
'检测是否只包含英文和数字
'*************************************
Function IsValidChars(str)
Dim re,chkstr
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="[^_.a-zA-Zd]"
IsValidChars=True
chkstr=re.Replace(str,"")
if chkstr<>str then IsValidChars=False
set re=nothing
End Function

'*************************************
'检测是否只包含英文和数字
'*************************************
Function IsvalidValue(ArrayN,Str)
IsvalidValue = false
Dim GName
For Each GName in ArrayN
If Str = GName Then
IsvalidValue = true
Exit For
End If
Next
End Function

'*************************************
'检测是否有效的数字
'*************************************
Function IsInteger(Para)
IsInteger=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
IsInteger=True
End If
End Function

'*************************************
'用户名检测
'*************************************
Function IsValidUserName(byVal UserName)
on error resume next
Dim i,c
Dim VUserName
IsValidUserName = True
For i = 1 To Len(UserName)
c = Lcase(Mid(UserName, i, 1))
If InStr("$!<>?#^%@~`&*();:+='"" ", c) > 0 Then
IsValidUserName = False
Exit Function
End IF
Next
For Each VUserName in Register_UserName
If UserName = VUserName Then
IsValidUserName = False
Exit For
End If
Next
End Function

'*************************************
'检测是否有效的E-mail地址
'*************************************
Function IsValidEmail(Email)
Dim names, name, i, c
IsValidEmail = True
Names = Split(email, "@")
If UBound(names) <> 1 Then
IsValidEmail = False
Exit Function
End If
For Each name IN names
If Len(name) <= 0 Then
IsValidEmail = 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
IsValidEmail = false
Exit Function
End If
Next
If Left(name, 1) = "." or Right(name, 1) = "." Then
IsValidEmail = false
Exit Function
End If
Next
If InStr(names(1), ".") <= 0 Then
IsValidEmail = False
Exit Function
End If
i = Len(names(1)) - InStrRev(names(1), ".")
If i <> 2 And i <> 3 Then
IsValidEmail = False
Exit Function
End If
If InStr(email, "..") > 0 Then
IsValidEmail = False
End If
End Function

'*************************************
'加亮关键字
'*************************************
Function highlight(byVal strContent,byRef arrayWords)
Dim intCounter,strTemp,intPos,intTagLength,intKeyWordLength,bUpdate
if len(arrayWords)<1 then highlight=strContent:exit function
For intPos = 1 to Len(strContent)
bUpdate = False
If Mid(strContent, intPos, 1) = "<" Then
On Error Resume Next
intTagLength = (InStr(intPos, strContent, ">", 1) - intPos)
if err then
highlight=strContent
err.clear
end if
strTemp = strTemp & Mid(strContent, intPos, intTagLength)
intPos = intPos + intTagLength
End If
If arrayWords <> "" Then
intKeyWordLength = Len(arrayWords)
If LCase(Mid(strContent, intPos, intKeyWordLength)) = LCase(arrayWords) Then
strTemp = strTemp & "" & Mid(strContent, intPos, intKeyWordLength) & ""
intPos = intPos + intKeyWordLength - 1
bUpdate = True
End If
End If
If bUpdate = False Then
strTemp = strTemp & Mid(strContent, intPos, 1)
End If
Next
highlight = strTemp
End Function

'*************************************
'过滤超链接
'*************************************
Function checkURL(ByVal ChkStr)
Dim str:str=ChkStr
str=Trim(str)
If IsNull(str) Then
checkURL = ""
Exit Function
End If
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="(d)(ocument.cookie)"
Str = re.replace(Str,"$1ocument cookie")
re.Pattern="(d)(ocument.write)"
Str = re.replace(Str,"$1ocument write")
re.Pattern="(s)(cript:)"
Str = re.replace(Str,"$1cript ")
re.Pattern="(s)(cript)"
Str = re.replace(Str,"$1cript")
re.Pattern="(o)(bject)"
Str = re.replace(Str,"$1bject")
re.Pattern="(a)(pplet)"
Str = re.replace(Str,"$1pplet")
re.Pattern="(e)(mbed)"
Str = re.replace(Str,"$1mbed")
Set re=Nothing
Str = Replace(Str, ">", ">")
Str = Replace(Str, "<", "<")
checkURL=Str
end function

'*************************************
'过滤文件名字
'*************************************
Function FixName(UpFileExt)
If IsEmpty(UpFileExt) Then Exit Function
FixName = Ucase(UpFileExt)
FixName = Replace(FixName,Chr(0),"")
FixName = Replace(FixName,".","")
FixName = Replace(FixName,"ASP","")
FixName = Replace(FixName,"ASA","")
FixName = Replace(FixName,"ASPX","")
FixName = Replace(FixName,"CER","")
FixName = Replace(FixName,"CDX","")
FixName = Replace(FixName,"HTR","")
End Function

'*************************************
'过滤特殊字符
'*************************************
Function CheckStr(byVal ChkStr)
Dim Str:Str=ChkStr
If IsNull(Str) Then
CheckStr = ""
Exit Function
End If
Str = Replace(Str, "&", "&")
Str = Replace(Str,"'","'")
Str = Replace(Str,"""",""")
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="(w)(here)"
Str = re.replace(Str,"$1here")
re.Pattern="(s)(elect)"
Str = re.replace(Str,"$1elect")
re.Pattern="(i)(nsert)"
Str = re.replace(Str,"$1nsert")
re.Pattern="(c)(reate)"
Str = re.replace(Str,"$1reate")
re.Pattern="(d)(rop)"
Str = re.replace(Str,"$1rop")
re.Pattern="(a)(lter)"
Str = re.replace(Str,"$1lter")
re.Pattern="(d)(elete)"
Str = re.replace(Str,"$1elete")
re.Pattern="(u)(pdate)"
Str = re.replace(Str,"$1pdate")
re.Pattern="(s)(or)"
Str = re.replace(Str,"$1or")
Set re=Nothing
CheckStr=Str
End Function

'*************************************
'恢复特殊字符
'*************************************
Function UnCheckStr(ByVal Str)
If IsNull(Str) Then
UnCheckStr = ""
Exit Function
End If
Str = Replace(Str,"'","'")
Str = Replace(Str,""","""")
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="(w)(here)"
str = re.replace(str,"$1here")
re.Pattern="(s)(elect)"
str = re.replace(str,"$1elect")
re.Pattern="(i)(nsert)"
str = re.replace(str,"$1nsert")
re.Pattern="(c)(reate)"
str = re.replace(str,"$1reate")
re.Pattern="(d)(rop)"
str = re.replace(str,"$1rop")
re.Pattern="(a)(lter)"
str = re.replace(str,"$1lter")
re.Pattern="(d)(elete)"
str = re.replace(str,"$1elete")
re.Pattern="(u)(pdate)"
str = re.replace(str,"$1pdate")
re.Pattern="(s)(or)"
Str = re.replace(Str,"$1or")
Set re=Nothing
Str = Replace(Str, "&", "&")
UnCheckStr=Str
End Function

'*************************************
'转换HTML代码
'*************************************
Function HTMLEncode(ByVal reString)
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = Replace(Str, ">", ">")
Str = Replace(Str, "<", "<")
Str = Replace(Str, CHR(9), "    ")
Str = Replace(Str, CHR(39), "'")
Str = Replace(Str, CHR(32)&CHR(32), " ")
Str = Replace(Str, CHR(34), """)
Str = Replace(Str, CHR(13), "")
Str = Replace(Str, CHR(10), "
")
HTMLEncode = Str
End If
End Function

'*************************************
'转换最新评论和日志HTML代码
'*************************************
Function CCEncode(ByVal reString)
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = Replace(Str, ">", ">")
Str = Replace(Str, "<", "<")
Str = Replace(Str, CHR(9), "    ")
Str = Replace(Str, CHR(39), "'")
Str = Replace(Str, CHR(32)&CHR(32), " ")
Str = Replace(Str, CHR(34), """)
Str = Replace(Str, CHR(13), "")
Str = Replace(Str, CHR(10), " ")
CCEncode = Str
End If
End Function

'*************************************
'反转换HTML代码
'*************************************
Function HTMLDecode(ByVal reString)
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = Replace(Str, ">", ">")
Str = Replace(Str, "<", "<")
Str = Replace(Str, "    ", CHR(9))
Str = Replace(Str, "'", CHR(39))
Str = Replace(Str, " ",CHR(32)&CHR(32))
Str = Replace(Str, """, CHR(34))
Str = Replace(Str, "", CHR(13))
Str = Replace(Str, "
", CHR(10))
HTMLDecode = Str
End If
End Function

'*************************************
'恢复&字符
'*************************************
function ClearHTML(ByVal reString)
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = Replace(Str, "&", "&")
ClearHTML = Str
End If
End Function

'*************************************
'过滤textarea
'*************************************
Function UBBFilter(ByVal reString)
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = Replace(Str, "", "</textarea>")
UBBFilter = Str
End If
End Function

'*************************************
'过滤HTML代码
'*************************************
Function EditDeHTML(byVal Content)
EditDeHTML=Content
IF Not IsNull(EditDeHTML) Then
EditDeHTML=UnCheckStr(EditDeHTML)
EditDeHTML=Replace(EditDeHTML,"&","&")
EditDeHTML=Replace(EditDeHTML,"<","<")
EditDeHTML=Replace(EditDeHTML,">",">")
EditDeHTML=Replace(EditDeHTML,chr(34),""")
EditDeHTML=Replace(EditDeHTML,chr(39),"'")
End IF
End Function

'*************************************
'日期转换函数
'*************************************
Function DateToStr(DateTime,ShowType)
Dim DateMonth,DateDay,DateHour,DateMinute,DateWeek,DateSecond
Dim FullWeekday,shortWeekday,Fullmonth,Shortmonth,TimeZone1,TimeZone2
TimeZone1="+0800"
TimeZone2="+08:00"
FullWeekday=Array("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
shortWeekday=Array("Sun","Mon","Tue","Wed","Thu","Fri","Sat")
Fullmonth=Array("January","February","March","April","May","June","July","August","September","October","November","December")
Shortmonth=Array("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")

DateMonth=Month(DateTime)
DateDay=Day(DateTime)
DateHour=Hour(DateTime)
DateMinute=Minute(DateTime)
DateWeek=weekday(DateTime)
DateSecond=Second(DateTime)
If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
If Len(DateDay)<2 Then DateDay="0"&DateDay
If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
Select Case ShowType
Case "Y-m-d"
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
Case "Y-m-d H:I A"
Dim DateAMPM
If DateHour>12 Then
DateHour=DateHour-12
DateAMPM="PM"
Else
DateHour=DateHour
DateAMPM="AM"
End If
If Len(DateHour)<2 Then DateHour="0"&DateHour
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM
Case "Y-m-d H:I:S"
If Len(DateHour)<2 Then DateHour="0"&DateHour
If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
Case "YmdHIS"
DateSecond=Second(DateTime)
If Len(DateHour)<2 Then DateHour="0"&DateHour
If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond
Case "ym"
DateToStr=Right(Year(DateTime),2)&DateMonth
Case "d"
DateToStr=DateDay
Case "ymd"
DateToStr=Right(Year(DateTime),4)&DateMonth&DateDay
Case "mdy"
Dim DayEnd
select Case DateDay
Case 1
DayEnd="st"
Case 2
DayEnd="nd"
Case 3
DayEnd="rd"
Case Else
DayEnd="th"
End Select
DateToStr=Fullmonth(DateMonth-1)&" "&DateDay&DayEnd&" "&Right(Year(DateTime),4)
Case "w,d m y H:I:S"
DateSecond=Second(DateTime)
If Len(DateHour)<2 Then DateHour="0"&DateHour
If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
DateToStr=shortWeekday(DateWeek-1)&","&DateDay&" "& Left(Fullmonth(DateMonth-1),3) &" "&Right(Year(DateTime),4)&" "&DateHour&":"&DateMinute&":"&DateSecond&" "&TimeZone1
Case "y-m-dTH:I:S"
If Len(DateHour)<2 Then DateHour="0"&DateHour
If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&"T"&DateHour&":"&DateMinute&":"&DateSecond&TimeZone2
Case Else
If Len(DateHour)<2 Then DateHour="0"&DateHour
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute
End Select
End Function



'*************************************
'分页函数
'*************************************
dim FirstShortCut,ShortCut
FirstShortCut=false
Function MultiPage(Numbers,Perpage,Curpage,Url_Add,aname,Style)
CurPage=Int(Curpage)
Numbers=Int(Numbers)
Dim URL
URL=Request.ServerVariables("Script_Name")&Url_Add
MultiPage=""
Dim Page,Offset,PageI
' If Int(Numbers)>Int(PerPage) Then
Page=9
Offset=4
Dim Pages,FromPage,ToPage
If Numbers Mod Cint(Perpage)=0 Then
Pages=Int(Numbers/Perpage)
Else
Pages=Int(Numbers/Perpage)+1
End If
FromPage=Curpage-Offset
ToPage=Curpage+Page-Offset-1
If Page>Pages Then
FromPage=1
ToPage=Pages
Else
If FromPage<1 Then
Topage=Curpage+1-FromPage
FromPage=1
If (ToPage-FromPage) ElseIF Topage>Pages Then
FromPage =Curpage-Pages +ToPage
ToPage=Pages
If (ToPage-FromPage) End If
End If
MultiPage="
    "
    'if Curpage<>1 then MultiPage=MultiPage&"
  • "
    MultiPage=MultiPage&"
  • "
    if Curpage<>1 then MultiPage=MultiPage&"< | "
    if not FirstShortCut then ShortCut=" accesskey="",""" else ShortCut=""
    if Curpage<>1 then MultiPage=MultiPage&""
    For PageI=FromPage TO ToPage
    If PageI<>CurPage Then
    MultiPage=MultiPage&""&PageI&" | "
    Else
    MultiPage=MultiPage&""&PageI&""
    if PageI<>Pages then MultiPage=MultiPage&" | "
    End If
    Next
    if not FirstShortCut then ShortCut=" accesskey="".""" else ShortCut=""
    if Curpage<>pages then MultiPage=MultiPage&""
    if Curpage<>pages then MultiPage=MultiPage&">"
    MultiPage=MultiPage&"
    • "
    'If Int(Pages)>Int(Page) Then
    ' MultiPage=MultiPage&"
  • ...
  • "&pages&"
    • "
    'End If
    'if Curpage<>pages then MultiPage=MultiPage&"
  • "
    MultiPage=MultiPage&"
"
' End If
FirstShortCut=true
End Function

'*************************************
'切割内容 - 按行分割
'*************************************
Function SplitLines(byVal Content,byVal ContentNums)
Dim ts,i,l
ContentNums=int(ContentNums)
If IsNull(Content) Then Exit Function
i=1
ts = 0
For i=1 to Len(Content)
l=Lcase(Mid(Content,i,5))
If l="
" Then
ts=ts+1
End If
l=Lcase(Mid(Content,i,4))
If l="
" Then
ts=ts+1
End If
l=Lcase(Mid(Content,i,3))
If l="

" Then
ts=ts+1
End If
If ts>ContentNums Then Exit For
Next
If ts>ContentNums Then
Content=Left(Content,i-1)
End If
SplitLines=Content
End Function
当前1/2页 12下一页阅读全文

魔客吧温馨提示：如果您是第一次建站，那么魔客吧推荐大家使用 织梦 系统。完全开源，易于二次开发，对搜索引擎SEO友好，新手首选。

分享到 更多 <script type="text/javascript" id="bdshell_js"></script><script type="text/javascript">document.getElementById("bdshell_js").src = "http://share.baidu.com/static/js/shell_v2.js?cdnversion=" + new Date().getHours();</script> 本文地址：http://www.moke8.com/article-21962-1.html
文章标题：pjblog2的参数第1/2页 收藏邀请 最新分享资源 包装材料生产线设备织梦模板

包装材料生产线设备织梦模板

dedecms模板 by moke 响应式淘宝美工摄影类织梦模板

响应式淘宝美工摄影类织梦模板

dedecms模板 by moke 响应式金属制品dedecms模板

响应式金属制品dedecms模板

dedecms模板 by moke 响应式无人机电子产品dede模板

响应式无人机电子产品dede模板

dedecms模板 by moke

最新评论

验证码 换一个 <script type="text/javascript" reload="1">updateseccode('Scu1P1y0');</script>

相关分类

  • PHP编程
  • ASP编程
  • NET编程
  • JSP编程
  • MSSQL教程
  • MYSQL教程

精品推荐

中英双语响应式电子企业织梦模板

精华 中英双语响应式电子企业织梦模板

dedecms模板 by moke

极品资源

高端建筑装饰带手机版十配色织梦模板

极品 高端建筑装饰带手机版十配色织梦模板

dedecms模板 by moke

原创模板

多配色创意metro风格企业

魔币 多配色创意metro风格企业

下载排行

  • 01包装材料生产线设备织梦模板

资源分类

企业网站模板 企业网站源码 个人网站模板 个人网页模板 手机wap网站 门户网站模板 商业源码 淘宝客程序 html5网站 网站后台模板 html网页模板 学校网站模板 <script type="text/javascript">var cookieLogin = Ajax("TEXT");cookieLogin.get("connect.php?mod=check&op=cookie", function() {});</script><script type="text/javascript">_attachEvent(window, 'load', getForbiddenFormula, document);function getForbiddenFormula() {var toGetForbiddenFormulaFIds = function () {ajaxget('plugin.php?id=cloudsearch&formhash=d193b6b1');};var a = document.body.getElementsByTagName('a');for(var i = 0;i < a.length;i++){if(a[i].getAttribute('sc')) {a[i].setAttribute('mid', hash(a[i].href));a[i].onmousedown = function() {toGetForbiddenFormulaFIds();};}}var btn = document.body.getElementsByTagName('button');for(var i = 0;i < btn.length;i++){if(btn[i].getAttribute('sc')) {btn[i].setAttribute('mid', hash(btn[i].id));btn[i].onmousedown = function() {toGetForbiddenFormulaFIds();};}}}</script>

联系我们 | 关于我们 | 招商加盟 | 版权声明 | 帮助中心 | 广告服务 | 网站地图

欢迎浏览魔客吧提供的 pjblog2的参数第1/2页 信息，若本站中的信息侵犯了您的权益，请与本站管理员联系

Copyright @ 2010-2015 魔客吧 版权所有 蜀ICP备09014119号 川公网安备51050202000165号   <script type="text/javascript" src="http://tcss.qq.com/ping.js?v=1VERHASH" charset="utf-8"></script><script type="text/javascript" reload="1">pgvMain({"discuzParams":{"r2":"5238379","ui":0,"rt":"portal","pn":1,"qq":"000"},"extraParams":""});</script>

积分 0, 距离下一级还需 积分 <script type="text/javascript">_attachEvent(window, 'scroll', function(){showTopLink();});</script><script>(function(){ var bp = document.createElement('script'); var curProtocol = window.location.protocol.split(':')[0]; if (curProtocol === 'https'){ bp.src = 'https://zz.bdstatic.com/linksubmit/push.js'; } else{ bp.src = 'http://push.zhanzhang.baidu.com/push.js'; } var s = document.getElementsByTagName("script")[0]; s.parentNode.insertBefore(bp, s);})();</script> <script type="text/javascript"> var tipsinfo = '5238379|X2.5|0.6||0||0|7|1526822184|7321a470bfb7627d565f9147eb9e6a07|2'; </script> <script src="http://discuz.gtimg.cn/cloud/scripts/discuz_tips.js?v=1" type="text/javascript" charset="UTF-8"></script><script type="text/javascript" src="https://idm-su.baidu.com/su.js"></script>
相关热词搜索： pjblog2的参数第1 2页
上一篇：ASP智能搜索的实现
下一篇：SQL Server实现自动循环归档分区数据脚本详解
关于我们|联系我们|版权声明|友情链接|广告服务
Copyright © 2020 人工智能实验室 版权所有.