开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 通讯/手机编程 > 手机WAP编程 > 查看源码
UtilClass.asp
资源名称：1-091024064918.rar　[点击查看]
上传用户：qfkgdy
上传日期：2020-06-18
资源大小：1888k
文件大小：33k
源码类别：

手机WAP编程

开发平台：

ASP/ASPX

UtilClass.asp：源码内容
  1. <%
  2. Class UtilClass
  4. Dim pageEmpty,page,pagenum,paramname,num,psize,wpage,tagNum,positionNum
  6. Dim position()
  8. Private Sub Class_Initialize
  9. pageEmpty=true
  10. tagNum=0
  11. positionNum=0
  12. End Sub
  14. '星期
  15. Function week(w)
  16. select case w
  17. case 1:week="日"
  18. case 2:week="一"
  19. case 3:week="二"
  20. case 4:week="三"
  21. case 5:week="四"
  22. case 6:week="五"
  23. case 7:week="六"
  24. end select
  25. End Function
  27. '防止二次提交
  28. Function token(ByVal t)
  29. Dim s
  30. select case t
  31. case 0:'播种
  32. s=tsn
  33. session("token")=s
  34. token="<postfield name=""token"" value="""&s&""" />"
  35. case 1:'取种
  36. s=request("token")
  37. if(s=session("token")) then
  38. token=true
  39. session("token")=""
  40. end if
  41. end select
  42. End Function
  44. '是否为有效IP
  45. Function ipValid()
  46. if(ipType(ip)=0) then
  47. ipValid=false
  48. else
  49. ipValid=true
  50. end if
  51. End Function
  53. '判断IP类型
  54. Function ipType(sip)
  55. Dim intIp
  56. intIp=ipInt(sip)
  58. '移动IP段(211.103.0.0-211.103.127.255 211.136.0.0-211.143.255.255 218.200.0.0-218.207.255.255 221.130.0.0-221.131.255.255)
  59. if(intIp>=3546742784 and intIp<=3546775551) or (intIp>=3548905472 and intIp<=3549429759) or (intIp>=3670540288 and intIp<=3671064575) or (intIp>=3716284416 and intIp<=3716415487) then
  60. ipType=1
  61. '联通IP段(61.240.0.0-61.243.255.255 61.245.0.0-61.245.127.255 220.192.0.0-220.207.255.255 211.90.0.0-211.97.255.255)
  62. elseif(intIp>=1039138816 and intIp<=1039400959) or (intIp>=1039466496 and intIp<=1039499263) or (intIp>=3703570432 and intIp<=3704619007) or (intIp>=3545890816 and intIp<=3546415103) then
  63. ipType=2
  64. '其它
  65. else
  66. ipType=0
  67. end if
  68. End Function
  70. 'IP转换为数字
  71. Function ipInt(sip)
  72. if not(isnull(sip) or sip="") then
  73. on error resume next
  74. dim strIp,arrIp
  75. strIp=cstr(trim(sip))
  76. arrIp=split(strIp,".")
  77. ipInt=arrIp(0)*256*256*256+arrIp(1)*256*256+arrIp(2)*256+arrIp(3)
  78. if(err.number>0) then
  79. ipInt=0
  80. end if
  81. else
  82. ipInt=0
  83. end if
  84. End Function
  86. '对应表
  87. Function hashmap(ByVal t,ByVal v)
  88. select case t
  89. case 1:'搜索(性别)
  90. select case v
  91. case 1:hashmap="男"
  92. case 2:hashmap="女"
  93. case 3:hashmap="不限"
  94. end select
  95. case 2:'搜索(年龄)
  96. select case v
  97. case 1:hashmap="18-26"
  98. case 2:hashmap="26-35"
  99. case 3:hashmap="18岁以下"
  100. case 4:hashmap="35岁以上"
  101. case 5:hashmap="不限"
  102. end select
  103. end select
  104. End Function
  106. '根据后缀判断是否为图片
  107. Function isImage(ByVal suffix)
  108. if(instr("gif jpg png jpeg ",suffix&" ")>0) then
  109. isImage=true
  110. end if
  111. End Function
  113. '解析自定义标签
  114. Public Function parseTag(str)
  115. parseTag=parsePictureTag(str)
  116. parseTag=parseSoftTag(str)
  117. parseTag=parseGameTag(str)
  118. parseTag=parseThemeTag(str)
  119. parseTag=parseThreadTag(str)
  120. End Function
  122. '解析图片标签
  123. Public Function parsePictureTag(str)
  124. Set rx=reg("(p:([^() trn}]+))", True, True)
  125. Set objMatches = rx.Execute(str)
  126. For Each objMatch In objMatches
  127.   str=replace(str,objMatch.Value,rx.replace(objMatch.Value,"<a href=""/picture/view.asp?id=$1"">免费高清下载此图片</a>"))
  128. Next
  129. Set rx = Nothing
  130. parsePictureTag=str
  131. End Function
  133. '解析软件标签
  134. Public Function parseSoftTag(str)
  135. Set rx=reg("(r:([^() trn}]+))", True, True)
  136. Set objMatches = rx.Execute(str)
  137. For Each objMatch In objMatches
  138.   str=replace(str,objMatch.Value,rx.replace(objMatch.Value,"<a href=""/soft/view.asp?id=$1"">免费下载此软件</a>"))
  139. Next
  140. Set rx = Nothing
  141. parseSoftTag=str
  142. End Function
  144. '解析游戏标签
  145. Public Function parseGameTag(str)
  146. Set rx=reg("(y:([^() trn}]+))", True, True)
  147. Set objMatches = rx.Execute(str)
  148. For Each objMatch In objMatches
  149.   str=replace(str,objMatch.Value,rx.replace(objMatch.Value,"<a href=""/game/view.asp?id=$1"">免费下载此游戏</a>"))
  150. Next
  151. Set rx = Nothing
  152. parseGameTag=str
  153. End Function
  155. '解析主题标签
  156. Public Function parseThemeTag(str)
  157. Set rx=reg("(z:([^() trn}]+))", True, True)
  158. Set objMatches = rx.Execute(str)
  159. For Each objMatch In objMatches
  160.   str=replace(str,objMatch.Value,rx.replace(objMatch.Value,"<a href=""/theme/view.asp?id=$1"">免费下载此主题</a>"))
  161. Next
  162. Set rx = Nothing
  163. parseThemeTag=str
  164. End Function
  166. '解析帖子标签
  167. Public Function parseThreadTag(str)
  168. Set rx=reg("(t:([^() trn}]+))", True, True)
  169. Set objMatches = rx.Execute(str)
  170. For Each objMatch In objMatches
  171.   str=replace(str,objMatch.Value,rx.replace(objMatch.Value,"<a href=""/bbs/thread.asp?tid=$1"">进入查看此贴</a>"))
  172. Next
  173. Set rx = Nothing
  174. parseThreadTag=str
  175. End Function
  177. '网址转换(兼容FLASH escape)
  178. Function URLEncode(ByVal u)
  179. URLEncode=replace(server.URLEncode(u),"+","%20")
  180. End Function
  182. '阿拉伯数字转中文数字
  183. Function corder(ByVal n)
  184. dim i,j,k,strlen,retval,x,y,z,str
  185. z=array("零","一","二","三","四","五","六","七","八","九")
  186. y=array("","十","百","千")
  187. x=Array("","万","亿","万万亿")
  188. strlen=len(n)
  189. str1=n
  190. for i=1 to strlen
  191. j=mid(str1,i,1)
  192. retval=retval&z(j)
  193. if(j>0) then retval=retval&y((strlen-i) mod 4)
  194. retval=replace(retval,z(0)&z(0),z(0))
  195. if((strlen-i) mod 4)=0 and right(retval,1)=z(0) then retval=left(retval,len(retval)-1)
  196. if((strlen-i) mod 4)=0 then retval=retval&x(int((strlen-i)/4))
  197. next
  198. if(left(retval,2)="一十") then retval="十" & right(retval,len(retval)-2)
  199. corder=retval
  200. End Function
  202. '帖子类型
  203. Function thread(is_top,is_comment,is_elite,is_attach,is_lock)
  204. if(is_top=1 or is_top=2) then thread=thread&"[顶]"
  205. if(is_comment=1) then thread=thread&"[荐]"
  206. if(is_elite=1) then thread=thread&"[精]"
  207. if(is_attach>0) then thread=thread&"[附]"
  208. if(is_lock=1) then thread=thread&"[锁]"
  209. End Function
  211. '是否
  212. Function whether(w)
  213. if(w=1) then
  214. whether="是"
  215. else
  216. whether="否"
  217. end if
  218. End Function
  220. '检查颜色代码
  221. Function color(c)
  222. dim regex
  223. set regex=new RegExp
  224. regex.pattern="^#?[0-9|a-f|A-F]{6}$"
  225. color=regex.test(c)
  226. End Function
  228. '检查手机号码
  229. Function mobile(m)
  230. dim regex
  231. set regex=new RegExp
  232. regex.pattern="^(130|131|132|133|134|135|136|137|138|139|159|158|156)d{8}$"
  233. mobile=regex.test(m)
  234. End Function
  236. '条件
  237. Function con(ByVal c1,c2,c3)
  238. if(c1) then
  239. con=c2
  240. else
  241. con=c3
  242. end if
  243. End Function
  245. '未知
  246. Function unknown(ByVal t1,t2,t3)
  247. if(t1=t2) then
  248. unknown=t3
  249. else
  250. unknown=t1
  251. end if
  252. End Function
  254. '血型
  255. Function stature(s)
  256. select case s
  257. case 1:stature="160-165cm"
  258. case 2:stature="165-170cm"
  259. case 3:stature="170-175cm"
  260. case 4:stature="175-180cm"
  261. case 5:stature="160cm以下"
  262. case 6:stature="180cm以上"
  263. end select
  264. End Function
  266. '血型
  267. Function blood(b)
  268. select case b
  269. case 1:blood="A"
  270. case 2:blood="B"
  271. case 3:blood="AB"
  272. case 4:blood="O"
  273. case else:blood="未知"
  274. end select
  275. End Function
  277. '星座
  278. Function constellation(c)
  279. select case c
  280. case 1:constellation="水瓶座"
  281. case 2:constellation="双鱼座"
  282. case 3:constellation="白羊座"
  283. case 4:constellation="金牛座"
  284. case 5:constellation="双子座"
  285. case 6:constellation="巨蟹座"
  286. case 7:constellation="狮子座"
  287. case 8:constellation="处女座"
  288. case 9:constellation="天秤座"
  289. case 10:constellation="天蝎座"
  290. case 11:constellation="射手座"
  291. case 12:constellation="魔蝎座"
  292. case else:constellation="未知"
  293. end select
  294. End Function
  296. '生肖
  297. Function zodiac(z)
  298. select case z
  299. case 1:zodiac="鼠"
  300. case 2:zodiac="牛"
  301. case 3:zodiac="虎"
  302. case 4:zodiac="兔"
  303. case 5:zodiac="龙"
  304. case 6:zodiac="蛇"
  305. case 7:zodiac="马"
  306. case 8:zodiac="羊"
  307. case 9:zodiac="猴"
  308. case 10:zodiac="鸡"
  309. case 11:zodiac="狗"
  310. case 12:zodiac="猪"
  311. case else:zodiac="未知"
  312. end select
  313. End Function
  315. '学历
  316. Function education(e)
  317. select case e
  318. case 1:education="中学"
  319. case 2:education="大专"
  320. case 3:education="大学本科"
  321. case 4:education="双学士"
  322. case 5:education="硕士"
  323. case 6:education="博士"
  324. case else:education="未知"
  325. end select
  326. End Function
  328. '婚姻
  329. Function marriage(m)
  330. select case m
  331. case 1:marriage="未婚"
  332. case 2:marriage="已婚"
  333. case else:marriage="未知"
  334. end select
  335. End Function
  337. '资源名称
  338. Function resource(ByVal t,ByVal gid)
  339. if(t=0) then'中文
  340. select case gid
  341. case 1:resource="图片"
  342. case 2:resource="软件"
  343. case 3:resource="游戏"
  344. case 4:resource="主题"
  345. case 10:resource="贴子"
  346. end select
  347. else'英文
  348. select case gid
  349. case 1:resource="picture"
  350. case 2:resource="soft"
  351. case 3:resource="game"
  352. case 4:resource="theme"
  353. case 10:resource="thread"
  354. end select
  355. end if
  356. End Function
  358. '显示文件后缀
  359. Function ftype(f)
  360. ftype=split(f,".")(1)
  361. End Function
  363. '显示文件大小
  364. Function fsize(f)
  365. fsize=clng(f/1024)&"K"
  366. End Function
  368. '格式化生日
  369. Function birthday(b)
  370. if(b="") then
  371. birthday="1900-01-01"
  372. else
  373. birthday=left(b,4)&"-"&mid(b,5,2)&"-"&mid(b,7,2)
  374. end if
  375. End Function
  377. '检查生日格式
  378. Function isBirthday(b)
  379. if(isDate(birthday(b))) then
  380. isBirthday=true
  381. end if
  382. End Function
  384. '地区
  385. Function area(a)
  386. a=trim(a)
  387. if(a="" or a=",") then
  388. area="地区不详"
  389. else
  390. area=a
  391. end if
  392. End Function
  394. '年龄
  395. Function age(a)
  396. if(isDate(a)) then
  397. if(a="1900-1-1") then
  398. age="年龄不详"
  399. else
  400. age=dateDiff("yyyy",a,date())&"岁"
  401. end if
  402. else
  403. age="年龄不详"
  404. end if
  405. End Function
  407. '性别
  408. Function sex(s)
  409. select case s
  410. case 1:sex="男"
  411. case 2:sex="女"
  412. case else:sex="未知"
  413. end select
  414. End Function
  416. 'WAP TAB
  417. Sub tab(a,b,c,d,e)
  418. if(a=b) then
  419. response.Write(c)
  420. else
  421. response.Write("<a href="""&d&b&""">"&c&"</a>")
  422. end if
  423. response.Write(e)
  424. End Sub
  426. '格式化后日期
  427. Function d()
  428.    d=convertDate(date,0)
  429. End Function
  431. '格式化后日期时间
  432. Function dt()
  433.    dt=convertDateTime(date)
  434. End Function
  436. '将一个一位的数字前面加零
  437. Function fillZero(str)
  438.    ttt=str
  439.    if len(str)=1 then
  440.   ttt="0" & str
  441.    end if
  442.    fillZero=ttt
  443. End Function
  445. '转化日期，将 一位补上零  2003-1-2  -->  2003-01-02
  446. Function convertDate(tDate,m)
  447.    ttt=tDate
  448.    if isdate(tDate) then
  449.   ttt=year(tDate) & "-" & fillZero(month(tDate))
  450.   if(m<>1) then
  451.    ttt=ttt & "-" & fillZero(day(tDate))
  452.   end if
  453.    end if
  454.    convertDate=ttt
  455. End Function
  457. '输入一个日期时间串，转换成年四位，其他两位的新的日期时间串
  458. Function convertDateTime(tDateTime)
  459.    ttt=tDateTime
  460.    if isdate(tDateTime) then
  461.   ttt=year(tDateTime) & "-" & fillZero(month(tDateTime)) & "-" & fillZero(day(tDateTime)) & " " & fillZero(cstr(hour(tDateTime))) & ":" & fillZero(cstr(minute(tDateTime))) & ":" & fillZero(cstr(second(tDateTime)))
  462.    end if
  463.    convertDateTime=ttt
  464. End Function
  466. '格式化RS
  467. Sub list(ByVal rs,cols,str,style,row_num,splitter,prefix,suffix)
  468. Dim li
  469. li=0
  470. Dim arrCols,url,title
  471. Dim link,arrLink
  472. if not rs.eof then
  473. if(prefix<>"") then
  474. response.Write(prefix&"<br/>")
  475. end if
  476. do while not rs.eof
  477. li=li+1
  478. link=str
  479. arrCols=split(cols,",")
  480. for i=0 to ubound(arrCols)
  481. link=replace(link,"{"&arrCols(i)&"}",rs(arrCols(i)))
  482. next
  483. arrLink=split(link,"|")
  484. if(ubound(arrLink)>1) then
  485. response.Write(arrLink(2))
  486. end if
  487. response.Write("<a href="""&arrLink(0)&""">"&arrLink(1)&"</a>")
  488. if(style=1) then
  489. response.Write("<br/>")
  490. else
  491. if((li mod row_num)=0) then
  492. response.Write("<br/>")
  493. else
  494. if(li<>rs.recordcount) then response.Write(splitter)
  495. end if
  496. end if
  497. rs.movenext
  498. loop
  499. if((li mod row_num)<>0) then response.Write("<br/>")
  500. if(suffix<>"") then
  501. response.Write(suffix&"<br/>")
  502. end if
  503. end if
  504. rs.close
  505. if(style=1) then
  506. if((li mod row_num)<>0) then
  507. response.Write("<br/>")
  508. end if
  509. end if
  510. End Sub
  512. '输出排序样式
  513. Function oc(ByVal action,column)
  514. if(action.by=column) then
  515. oc=action.order
  516. end if
  517. End Function
  519. '格式化网址
  520. Function formatUrl(ByVal url,ftype)
  521. url=trim(url)
  522. select case ftype
  523. case 0:
  524. url=replace(url,"http://","")
  525. formatUrl=url
  526. case 1:
  527. if(instr(url,"http://")>0) then
  528. formatUrl=url
  529. else
  530. formatUrl="http://"&url
  531. end if
  532. end select
  533. formatUrl=replace(formatUrl,"&amp;","&")
  534. formatUrl=replace(formatUrl,"&","&amp;")
  535. End Function
  537. '判断用户权限
  538. Function inDomains(ByVal domains,sid)
  539. if(instr(","&domains&",",","&sid&",")>0) then
  540. inDomains=true
  541. else
  542. inDomains=false
  543. end if
  544. End Function
  546. '正则
  547. Function reg(spattern,bglobal,bignorecase)
  548.   Dim rx
  549.   Set rx=New RegExp
  550.   rx.Pattern=spattern
  551.   rx.Global=bglobal
  552.   rx.IgnoreCase=bignorecase
  553.   Set reg=rx
  554.   Set rx=nothing
  555. End Function
  557. '手机号码中间3位显示*
  558. Function safeMobile(ByVal mobile)
  559. safeMobile=left(mobile,3)&"***"&right(mobile,5)
  560. End Function
  562. '直接输出下载文件
  563. Sub download(ByVal mime,filename,output)
  564. Call response.addHeader("content-type",mime)
  565. Call response.addHeader("Content-Disposition","attachment;filename="&filename)
  566. response.write(output)
  567. response.end()
  568. End Sub
  570. '数组是否存在项目中
  571. Function arrInstr(ByVal arr,value)
  572. if(isArray(arr)) then
  573. for i=0 to ubound(arr)
  574. if(instr(trim(value),arr(i))>0) then
  575. arrInstr=true
  576. exit function
  577. end if
  578. next
  579. end if
  580. End function
  582. '项目是否存在数组中
  583. Function inArray(ByVal arr,value)
  584. if(isArray(arr)) then
  585. for i=0 to ubound(arr)
  586. if(trim(arr(i))=trim(value)) then
  587. inArray=true
  588. exit function
  589. end if
  590. next
  591. end if
  592. End function
  594. 'ceil
  595. Function ceil(ByVal value)
  596. If(value>0) then
  597. value=FIX(value)+Sgn(value-FIX(value))
  598. Else
  599. value=FIX(value)
  600. End If
  601. ceil=value
  602. End function
  604. '验证EMAIL是否合法
  605. Function checkEmail(ByVal email)
  606. Dim re,pat
  607. Set re=New RegExp
  608. pat="^[w-.]{1,}@([da-zA-Z-]{1,}.){1,}[da-zA-Z-]{2,3}$" 
  609. re.pattern=pat
  610. re.ignoreCase=true
  611. checkEmail=re.Test(email)
  612. End Function
  614. '验证IMEI是否合法
  615. Function checkImei(ByVal imei)
  616. Dim re,pat
  617. Set re=New RegExp
  618. pat="^3d{14}$" 
  619. re.pattern=pat
  620. re.ignoreCase=true
  621. checkImei=re.Test(imei)
  622. End Function
  624. '判断checkbox中第一项值是否为key
  625. Function singleCheck(ByVal str,key)
  626. singleCheck=false
  627. Dim checkArr
  628. checkArr=split(str,",")
  629. if(ubound(checkArr)>=0) then
  630. if(checkArr(0)=key) then
  631. singleCheck=true
  632. end if
  633. end if
  634. End Function
  636. '循环打印字符串
  637. Function loopStr(ByVal loops,str)
  638. loopStr=""
  639. for i=1 to loops
  640. loopStr=loopStr&str
  641. next
  642. End Function
  644. '获取访问来源(支持REFERER与URL)
  645. 'urlParam为url时为相对地址
  646. Function getRefer(ByVal urlParam)
  647. Dim reUrl
  648. reUrl=request.ServerVariables("HTTP_REFERER")
  649. urlParam=trim(urlParam)
  650. if(urlParam<>"") then
  651. Dim urlValue
  652. urlValue=trim(request(urlParam))
  653. if(urlValue<>"") then
  654. reUrl=urlValue
  655. end if
  656. end if
  657. getRefer=reUrl
  658. End Function
  660. '清理所有COOKIE记录
  661. Function clearCookies()
  662. for each cookie in request.Cookies
  663. if not (request.Cookies(cookie).hasKeys) then
  664. response.Cookies(cookie)=empty
  665. else
  666. for each subkey in request.Cookies(cookie)
  667. response.Cookies(cookie)(subkey)=empty
  668. next
  669. end if
  670. next
  671. End Function
  673. '获取重写URL
  674. Function getRewriteUrl(inputStr,patStr)
  675. Dim regex,matches,match
  676. Set regex=new RegExp
  677. regex.ignoreCase=true
  678. regex.global=true
  679. regex.pattern=patStr
  680. Set matches=regex.execute(inputStr)
  681. Dim mValue,pName,pValue
  682. for each match in matches
  683. mValue=match.value
  684. pName=replace(mValue,"(","")
  685. pName=replace(pName,")","")
  686. pValue=request.QueryString(pName)
  687. inputStr=replace(inputStr,mValue,pValue)
  688. next
  689. Set match=nothing
  690. Set matches=nothing
  691. Set regex=nothing
  692. getRewriteUrl=inputStr
  693. End Function
  695. '获取textarea内容
  696. Function getTextarea(ByVal content)
  697. if(not isnull(content)) then
  698. getTextarea=replace(content,vbcrlf,"<br>")
  699. getTextarea=replace(getTextarea," ","&nbsp;")
  700. end if
  701. End Function
  703. '将textarea内容按行转换为数组
  704. Function getTextareaArr(ByVal content)
  705. if(not isnull(content)) then
  706. getTextareaArr=split(content,vbcrlf)
  707. end if
  708. End Function
  710. '将数组转换为textarea
  711. Function setTextarea(ByVal arr)
  712. Dim asize
  713. asize=ubound(arr)-1
  714. for i=0 to asize
  715. setTextarea=setTextarea&arr(i)
  716. if(i<>asize) then
  717. setTextarea=setTextarea&vbcrlf
  718. end if
  719. next
  720. End Function
  722. '获取客户端IP地址
  723. Function ip()
  724. ip=request.ServerVariables("REMOTE_ADDR")
  725. End Function
  727. '密码加密
  728. Function password(ByVal psw)
  729. psw=psw&SECURITY_ENCRYPT_KEY
  730. password=md5(psw,32)
  731. End Function
  733. '时间字符串
  734. Function tsn()
  735. tsn=year(date())&month(date())&day(date())&hour(now())&minute(now())&second(now())
  736. End Function
  738. '生成全局唯一识别码
  739. Function sn(ByVal v)
  740. randomize
  741. v=int(rnd*10000000)&tsn&ip&v
  742. sn=md5(v,16)
  743. sn=ucase(sn)
  744. End Function
  745. '生成随机数
  746. Function rndc()
  747. randomize
  748. vcc=int(rnd*10000000)
  749. rndc=md5(vcc,16)
  750. End Function
  751. '获取日期数组
  752. Function getDateArr(ByVal datetime)
  753. Dim dateArr(3)
  754. dateArr(0)=year(datetime)
  755. dateArr(1)=month(datetime)
  756. dateArr(2)=day(datetime)
  757. dateArr(3)=getDate(datetime)
  758. getDateArr=dateArr
  759. End Function
  761. '昨天日期
  762. Function getYesterday()
  763. Dim daTemp
  764. daTemp=getDateArr(datetime)
  765. getYesterday=daTemp(0)&"-"&daTemp(1)&"-"&dateArr(2)
  766. End Function
  768. '获取日期
  769. Function getDate(ByVal datetime)
  770. getDate=split(datetime," ")(0)
  771. End Function
  773. '对比时间
  774. Function compareDate(ByVal datetime1,datetime2)
  775. if(getDate(datetime1)=getDate(datetime2)) then
  776. compareDate=true
  777. else
  778. compareDate=false
  779. end if
  780. End Function
  782. '产生随机表单名
  783. Function formId(ByVal input)
  784. Randomize
  785. formId=input&int(rnd*10000000)&tsn
  786. End Function
  788. '调用翻页(普通)
  789. Function pager(ByVal rs,pagesize,pn)
  790. paramname=pn
  791. if(paramname="") then
  792. paramname=PAGER_PARAM
  793. end if
  794. pagerTemp=0
  795. If rs.recordcount>0 Then
  796. pageEmpty=false
  797. rs.pagesize = pagesize
  798. psize = pagesize
  799. num=rs.recordcount
  800. pagenum=rs.pagecount
  801. page=request(paramname) 
  802. If page <> "" then
  803. if not isnumeric(page) then
  804. page=0
  805. end if
  806. page = clng(page)
  807. if err.number <> 0 then
  808. err.clear
  809. page = 1
  810. end if
  811. if page < 1 then
  812. page = 1
  813. end if
  814. else
  815. page = 1
  816. End if
  817. if page*rs.pagesize > num and not((page-1)*rs.pagesize < num)then
  818. page=1
  819. end if
  820. rs.absolutepage = page
  821. if page<>pagenum then
  822. lablenum=rs.pagesize
  823. else
  824. lablenum=num-(page-1)*rs.pagesize
  825. end If
  827. pagerTemp=lablenum
  828. End If
  830. pager=pagerTemp
  831. End Function
  833. '调用翻页(对象)
  834. Function pagerObject(ByVal list,pagesize,pn)
  835. Dim nums(2)
  836. psize=pagesize
  837. paramname=pn
  838. if(paramname="") then
  839. paramname=PAGER_PARAM
  840. end if
  841. num=ubound(list)
  842. pagenum=ceil(num/psize)
  843. if(num>0) then
  844. pageEmpty=false
  845. page=request(paramname)
  846. page=limitLng(page,1,"")
  847. if(page>pagenum) then
  848. page=pagenum
  849. end if
  850. nums(0)=(page-1)*psize
  851. if(page<>pagenum) then
  852. nums(1)=page*psize
  853. else
  854. nums(1)=num
  855. end if
  856. end if
  857. pagerObject=nums
  858. End Function
  860. '调用翻页(存储过程)
  861. Sub pagerCommand(ByVal rc,pc,pn)
  862. paramname=pn
  863. if(paramname="") then
  864. paramname=PAGER_PARAM
  865. end if
  866. num=rc
  867. pagenum=pc
  868. if(num>0) then
  869. pageEmpty=false
  870. page=request(paramname)
  871. page=limitLng(page,1,"")
  872. if(page>pagenum) then
  873. page=pagenum
  874. end if
  875. end if
  876. End Sub
  878. '调用翻页(文字)
  879. Function pagerText(ByVal text,wsize,pn)
  880. paramname=pn
  881. if(paramname="") then
  882. paramname=PAGER_PARAM
  883. end if
  885. Dim wp,sw,ew,wlen
  886. page=limitInt(request(paramname),1,"")
  887. num=len(text)
  888. if(num>0) then
  889. pageEmpty=false
  890. wlen=len(text)
  891. pagenum=ceil(wlen/wsize)
  892. if (page=1) then
  893. sw=1
  894. else
  895. sw=(page-1)*wsize
  896. end if
  897. ew=wsize
  898. pagerText=mid(text,sw,ew)
  899. end if
  900. End Function
  902. '显示翻页
  903. Function paginate(ByVal ptype,url,rewrite)
  904. if (not pageEmpty) and (pagenum>1) Then
  905. Dim ut,ul,up,preUrl,sufUrl
  906. if(rewrite) then
  907. ut=PAGER_PARAM_COMMAND
  908. ul=len(url)
  909. up=instr(url,ut)
  910. preUrl=left(url,up-1)
  911. sufUrl=right(url,ul-up-len(ut)+1)
  912. else
  913. preUrl=getPage&"?"&paramname&"="
  914. if(url<>"") then
  915. if(ptype=0 or ptype=2 or ptype=3) then
  916. url="&amp;"&url
  917. else
  918. url="&"&url
  919. end if
  920. end if
  921. sufUrl=url
  922. end if
  923. Select Case ptype
  924. Case 0: 'WML
  925. if page<>pagenum then
  926. paginate=paginate&"<a href="""&preUrl&(page+1)&sufUrl&""">下页</a> "
  927. end if
  928. if page<>1 then
  929. paginate=paginate&"<a href="""&preUrl&(page-1)&sufUrl&""">上页</a> "
  930. end if
  931. if page<>1 then
  932. paginate=paginate&"<a href="""&preUrl&"1"&sufUrl&""">首页</a> "
  933. end if
  934. if page<>pagenum then
  935. paginate=paginate&"<a href="""&preUrl&pagenum&sufUrl&""">末页</a> "
  936. end if
  937. paginate=paginate&" "&num&"条"
  938. if pagenum<>1 then
  939. paginate=paginate&"<br/>"
  940. end if
  941. paginate=paginate&page&"/"&pagenum&"页"
  942. Dim inputName
  943. inputName=formId(paramname)
  944. paginate=paginate&" 至<input name="""&inputName&""" format=""*N"" value="""" size=""3"" emptyok=""true"" />页 <anchor title=""跳转"">跳转<go href="""&getUrl(paramname)&""" method=""get""><postfield name="""&paramname&""" value=""$("&inputName&")"" /></go></anchor><br/>"
  945. Case 1: 'HTML
  946. if page<>pagenum then
  947. paginate=paginate&"<div class=""button"" onMouseOver=""this.className='button button-hover'"" onMouseOut=""this.className='button'"" onclick=""go('"&preUrl&(page+1)&sufUrl&"');"" style=""float:right"" title=""下一页""><span class=""left""></span><span class=""center""><span class=""icon next""></span></span><span class=""right""></span></div>"
  948. end if
  949. paginate=paginate&"<div style=""float:right; padding-left:4px; padding-right:4px;""><select onchange=""go('"&preUrl&"'+this.value+'"&sufUrl&"');"">"
  950. for i=1 to pagenum
  951. paginate=paginate&"<option value="""&i&""" "
  952. if(i=page) then
  953. paginate=paginate&"selected=""selected"""
  954. end if
  955. paginate=paginate&"> "&i&" / "&pagenum&" </option>"
  956. next
  957. paginate=paginate&"</select></div>"
  958. if page<>1 then
  959. paginate=paginate&"<div class=""button"" onMouseOver=""this.className='button button-hover'"" onMouseOut=""this.className='button'"" onclick=""go('"&preUrl&(page-1)&sufUrl&"');"" style=""float:right"" title=""上一页""><span class=""left""></span><span class=""center""><span class=""icon prev""></span></span><span class=""right""></span></div>"
  960. end if
  961. Case 2: '内容翻页
  962. if page<>pagenum then
  963. paginate=paginate&"<a href="""&preUrl&(page+1)&sufUrl&""">下页("&(page+1)&"/"&pagenum&")</a> "
  964. end if
  965. if page<>1 then
  966. paginate=paginate&"<a href="""&preUrl&(page-1)&sufUrl&""">上页"
  967. if(page=pagenum) then
  968. paginate=paginate&"("&(page-1)&"/"&pagenum&")"
  969. end if
  970. paginate=paginate&"</a> "
  971. end if
  972. if page<>1 then
  973. paginate=paginate&"<a href="""&preUrl&"1"&sufUrl&""">首</a> "
  974. end if
  975. if page<>pagenum then
  976. paginate=paginate&"<a href="""&preUrl&pagenum&sufUrl&""">末</a> "
  977. end if
  978. if pagenum<>1 then paginate=paginate&"<br/>"
  979. Case 3: '组图翻页
  980. if page<>pagenum then
  981. paginate=paginate&"<a href="""&preUrl&(page+1)&sufUrl&""">下张("&(page+1)&"/"&pagenum&")</a> "
  982. end if
  983. if page<>1 then
  984. paginate=paginate&"<a href="""&preUrl&(page-1)&sufUrl&""">上张"
  985. if(page=pagenum) then
  986. paginate=paginate&"("&(page-1)&"/"&pagenum&")"
  987. end if
  988. paginate=paginate&"</a> "
  989. end if
  990. if page<>1 then
  991. paginate=paginate&"<a href="""&preUrl&"1"&sufUrl&""">首</a> "
  992. end if
  993. if page<>pagenum then
  994. paginate=paginate&"<a href="""&preUrl&pagenum&sufUrl&""">末</a> "
  995. end if
  996. if pagenum<>1 then
  997. paginate=paginate&" 共"&num&"张"
  998. paginate=paginate&"<br/>"
  999. end if
  1000. End Select
  1001. End if
  1002. End Function
  1004. '字符串字节长度
  1005. Function length(ByVal str)
  1006. dim lenStr
  1007. lenStr=0
  1008. lenTemp=len(str)
  1009. dim strTemp
  1010. for i=1 to lenTemp
  1011. strTemp=asc(mid(str,i,1))
  1012. if strTemp>255 or strTemp<=0 then
  1013. lenStr=lenStr+2
  1014. else
  1015. lenStr=lenStr+1
  1016. end if
  1017. next
  1018. length=lenStr
  1019. End Function
  1021. '判断是否为int
  1022. Function isInt(ByVal str)
  1023. if not isnumeric(str) or len(str)>5 then
  1024. isInt=false
  1025. exit function
  1026. elseif len(str)<5 then
  1027. isInt=true
  1028. exit function
  1029. end if
  1030. if cint(left(str,4))>3276 then
  1031. isInt=false
  1032. exit function
  1033. elseif cint(left(str,4))=3276 and cint(right(str,1))>7 then
  1034. isInt=false
  1035. exit function
  1036. else
  1037. isInt=true
  1038. exit function
  1039. end if
  1040. End Function
  1042. '判断是否为lng
  1043. Function isLng(ByVal str)
  1044. if not isnumeric(str) or len(str)>10 then
  1045. isLng=false
  1046. exit function
  1047. elseif len(str)<10 then
  1048. isLng=true
  1049. exit function
  1050. end if
  1051. if clng(left(str,9))>214748364 then
  1052. isLng=false
  1053. exit function
  1054. elseif clng(left(str,9))=214748364 and clng(right(str,1))>7 then
  1055. isLng=false
  1056. exit function
  1057. else
  1058. isLng=true
  1059. exit function
  1060. end if
  1061. End Function
  1063. '限制int范围
  1064. Function limitInt(ByVal num,min,max)
  1065. if(isInt(num)) then
  1066. num=cint(num)
  1067. else
  1068. num=0
  1069. end if
  1070. if(min="") then
  1071. min=-32768
  1072. end if
  1073. if(max="") then
  1074. max=32767
  1075. end if
  1076. if(num<min) then
  1077. limitInt=min
  1078. elseif(num>max) then
  1079. limitInt=max
  1080. else
  1081. limitInt=num
  1082. end if
  1083. End Function
  1085. '限制lng范围
  1086. Function limitLng(ByVal num,min,max)
  1087. if(isLng(num)) then
  1088. num=clng(num)
  1089. else
  1090. num=0
  1091. end if
  1092. if(min="") then
  1093. min=-2147483648
  1094. end if
  1095. if(max="") then
  1096. max=2147483647
  1097. end if
  1098. if(num<min) then
  1099. limitLng=min
  1100. elseif(num>max) then
  1101. limitLng=max
  1102. else
  1103. limitLng=num
  1104. end if
  1105. End Function
  1107. '限制boolean范围
  1108. Function limitBool(ByVal str)
  1109. limitBool=false
  1110. if(str<>"") then
  1111. if(isnumeric(str)) then
  1112. if(str=true) then
  1113. limitBool=true
  1114. exit function
  1115. end if
  1116. else
  1117. if(lcase(str)="true") then
  1118. limitBool=true
  1119. exit function
  1120. end if
  1121. end if
  1122. end if
  1123. End Function
  1125. '限制float范围
  1126. Function limitFloat(ByVal num,min,max)
  1127. if(min="") then
  1128. min=-2147483648
  1129. end if
  1130. if(max="") then
  1131. max=2147483647
  1132. end if
  1133. if(isLng(num)) then
  1134. if(clng(num)<=min) then
  1135. limitFloat=min
  1136. elseif(clng(num)>=max) then
  1137. limitFloat=max
  1138. else
  1139. limitFloat=num
  1140. end if
  1141. else
  1142. limitFloat=min
  1143. end if
  1144. End Function
  1146. '截取字符串
  1147. Function cut(str,strLen,symbol)
  1148. str=trim(str)
  1149. if length(str)>strLen then
  1150. cut=left(str,strLen-1)&symbol
  1151. else
  1152. cut=str
  1153. end if
  1154. End Function
  1156. '字符过滤函数
  1157. Function filter(ByVal fType,str)
  1158. select case fType
  1159. case "sql":'过滤SQL
  1160. if str="" then exit function 
  1161. str=replace(str,chr(34),"")
  1162. str=replace(str,chr(39),"")
  1163. case "html":'过滤HTML标签
  1164. dim objRegExp,match,matches,newStr,i
  1165. Set objRegExp=new Regexp
  1166. objRegExp.ignoreCase=true
  1167. objRegExp.global=true
  1168. objRegExp.pattern="<.+?>"
  1169. Set matches=objRegExp.Execute(str)
  1170. for each match in matches 
  1171. str=Replace(str,match.Value,"")
  1172. next
  1173. Set objRegExp=nothing
  1174. case "wml":'过滤非法WML字符
  1175. str=replace(str,"&","&amp;")
  1176. str=replace(str,">","&gt;")
  1177. str=replace(str,"<","&lt;")
  1178. str=replace(str,"""","&quot;")
  1179. str=replace(str,"{","")
  1180. str=replace(str,"}","")
  1181. str=replace(str,"[","")
  1182. str=replace(str,"]","")
  1183. '过滤乱码
  1184. for i=1 to len(str)
  1185. bitStr=mid(str,i,1)
  1186. ascNum=ascw(bitStr)
  1187. if ascNum>=0 and ascNum<=31 then
  1188. bitStr=""
  1189. end if
  1190. newStr=newStr&bitStr
  1191. next
  1192. str=newStr
  1193. '过滤默认表单值
  1194. set rx=reg("$(([^)]*))",true,true)
  1195. set objMatches=rx.execute(str)
  1196. for each objMatch in objMatches
  1197.   str=replace(str,objMatch.Value,rx.replace(objMatch.Value,""))
  1198. next
  1199. set rx=nothing
  1200. end select
  1201. filter=str
  1202. End Function
  1204. '获取HTTP请求参数值
  1205. Function req(ByVal fieldname,filters)
  1206. Dim fieldvalue
  1207. fieldvalue=request(fieldname)
  1208. Dim filterArr
  1209. filterArr=split(filters,"|")
  1210. for i=0 to UBound(filterArr)
  1211. fieldvalue=filter(filterArr(i),fieldvalue)
  1212. next
  1213. req=trim(fieldvalue)
  1214. End Function
  1216. '获取当前文件名
  1217.   Function getPage()
  1218. getPage=CStr(Request.ServerVariables("SCRIPT_NAME"))
  1219. End Function
  1221. '获取分页URL,param为page名称
  1222. Function getUrl(ByVal param)
  1223. Dim a,b,c,d,e
  1224. a=getPage&"?"&request.QueryString
  1225. e="&"
  1226. b=split(a,e)
  1227. for i=0 to ubound(b)
  1228. if(b(i)<>"") then
  1229. c=split(b(i),"=")
  1230. if(c(0)<>param) then
  1231. d=d&b(i)&"&amp;"
  1232. end if
  1233. end if
  1234. next
  1235. if(right(d,5)="&amp;") then
  1236. d=left(d,len(d)-5)
  1237. end if
  1238. if(right(d,1)="?") then
  1239. d=left(d,len(d)-1)
  1240. end if
  1241. getUrl=replace(replace(d,param&"="&request.QueryString(param),""),"?&amp;","?")
  1242. End Function
  1244. '获取URL参数的值
  1245. Function getUrlValue(ByVal param,url)
  1246. Dim a,b,c,d,e,f
  1247. a=url
  1248. c="?"
  1249. e="&amp;"
  1250. b=split(a,c)
  1251. if Ubound(b)>0 then
  1252. d=b(1)
  1253. b=split(d,e)
  1254. for i=0 to ubound(b)
  1255. if(b(i)<>"") then
  1256. f=split(b(i),"=")
  1257. if(f(0)=param) then
  1258. getUrlValue=f(1)
  1259. exit function
  1260. end if
  1261. end if
  1262. next
  1263. end if
  1264. End Function
  1266. '格式化时间
  1267. Function formatTime(ByVal t,tType)
  1268. dim yy,mm,dd,hh,min,sec
  1269. yy=right(year(t),2)
  1270. fyy=year(t)
  1271. mm=month(t)
  1272. dd=day(t)
  1273. hh=hour(t)
  1274. min=minute(t)
  1275. sec=second(t)
  1276. if mm<10 then
  1277. fmm="0"&mm
  1278. else
  1279. fmm=mm
  1280. end if 
  1281. if dd<10 then
  1282. fdd="0"&dd
  1283. else
  1284. fdd=dd
  1285. end if 
  1286. if hh<10 then
  1287. fhh="0"&hh
  1288. else
  1289. fhh=hh
  1290. end if
  1291. if min<10 then
  1292. fmin="0"&min
  1293. else
  1294. fmin=min
  1295. end if
  1296. if sec<10 then
  1297. fsec="0"&sec
  1298. else
  1299. fsec=sec
  1300. end if
  1301. Select Case tType
  1302. Case 1: formatTime=mm&"-"&dd&" "&hh&":"&min
  1303. Case 2: formatTime=yy&"-"&mm&"-"&dd&" "&hh&":"&min
  1304. Case 3: formatTime=fyy&fmm
  1305. Case 4: formatTime=yy&fmm&fdd
  1306. Case 5: formatTime=yy&fmm&fdd&hh&min
  1307. Case 6: formatTime=fyy&"-"&fmm
  1308. Case 7: formatTime=fyy&"年"&fmm&"月"
  1309. Case 8: formatTime=fmm&"月"&fdd&"日"
  1310. Case 9: formatTime=fyy&"年"&fmm&"月"&fdd&"日"
  1311. Case 10: formatTime=fyy&fmm&fdd
  1312. Case 11: formatTime=fmm&"-"&fdd
  1313. Case 12: formatTime=fmm&"-"&fdd&" "&hh&":"&fmin
  1314. Case 13: formatTime=fyy&"年"&fmm&"月"&fdd&"日"&" "&hh&":"&fmin
  1315. Case 14: formatTime=fyy&"-"&fmm&"-"&fdd
  1316. Case 15: formatTime=fyy&fmm&fdd&fhh&fmin&fsec
  1317. Case 16: formatTime=fyy&"-"&fmm&"-"&fdd&" "&fhh&":"&fmin&":"&fsec
  1318. Case 17: formatTime=fhh&":"&fmin
  1319. Case 18: formatTime=fmm&fdd
  1320. End Select
  1321. End Function
  1323. '返回时间字符串
  1324. Function returnTime(ByVal str,tType)
  1325. yy="20"&left(str,2)
  1326. mm=mid(str,3,2)
  1327. dd=right(str,2)
  1328. Select Case tType
  1329. Case 1:
  1330. returnTime=yy&"-"&mm&"-"&dd
  1331. End Select
  1332. End Function
  1334. '获取导航项目
  1335. Function getNav(ByVal columns)
  1336. Dim navList,navArr,nli,nls,navigation
  1337. navList=split(columns,"|")
  1338. nls=UBound(navList)
  1339. for nli=0 to nls
  1340. if(navList(nli)<>"") then
  1341. navArr=split(navList(nli),",")
  1342. if(navArr(1)<>"") then
  1343. navigation=navigation&"<a href="""&navArr(1)&""">"&navArr(0)&"</a>"
  1344. else
  1345. navigation=navigation&navArr(0)
  1346. end if
  1347. if(nli<>nls) then
  1348. if(navArr(0)<>"") then
  1349. navigation=navigation&"&gt;"
  1350. end if
  1351. end if
  1352. end if
  1353. next
  1354. getNav=navigation
  1355. End Function
  1357. '网站导航
  1358. Sub nav(ByVal params)
  1359. Dim navStr
  1360. navStr="首页,/index.asp"
  1361. if(params<>"") then
  1362. navStr=navStr&"|"&params
  1363. end if
  1364. response.Write("--------------------<br/>")
  1365. response.Write(getNav(navStr))
  1366. response.Write("<br/>本站资源全部免费!")
  1367. End Sub
  1369. '网站导航
  1370. Sub navs(ByVal params)
  1371. Dim navStr
  1372. navStr="首页,/index.asp"
  1373. if(params<>"") then
  1374. navStr=navStr&"|"&params
  1375. end if
  1376. response.Write("--------------------<br/>")
  1377. response.Write("<img src=""/Clear_temporary_files.Asp"" alt="".""/>")
  1378. response.Write(getNav(navStr))
  1379. 'response.Write("<br/>QQ:84554888")
  1380. 'response.Write("<br/>书签:<a href='wapck_com.SIS'>" & Request.ServerVariables("HTTP_HOST")) & "</a>"
  1381. End Sub
  1383. Sub antinav()
  1384. if(not session("antinav")) then
  1385. if(util.req("simulator","")="true") then
  1386. session("antinav")=true
  1387. end if
  1388. end if
  1389. if(not session("antinav")) then
  1390. browsers=Lcase(Left(Request.ServerVariables("HTTP_USER_AGENT"),4))
  1391. if browsers="oper" or browsers="winw" or browsers="wapi" or browsers="mc21" or browsers="up.b" or browsers="upg1" or browsers="upsi" or browsers="qwap" or browsers="jigs" or browsers="java" or browsers="alca" or browsers="wapj" or browsers="fetc" or browsers="r380" or browsers="mozi" or browsers="mozi" or browsers="cdr/" then
  1392. response.redirect "http://127.0.0.1"
  1393. end if
  1394. end if
  1395. End Sub
  1397. Private Sub Class_Terminate
  1399. End Sub
  1401. End Class
  1402. %>