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

源码开发语言/平台
当前位置：首页 > 源码/资料 > 中间件编程 > 查看源码
c_function.asp
资源名称：www.myworld.net.cn.rar　[点击查看]
上传用户：saigedz
上传日期：2019-10-14
资源大小：997k
文件大小：45k
源码类别：

中间件编程

开发平台：

HTML/CSS

c_function.asp：源码内容
  1. <%
  2. '///////////////////////////////////////////////////////////////////////////////
  3. '//              Z-Blog
  4. '// 作    者:    朱煊(zx.asd)
  5. '// 版权所有:    RainbowSoft Studio
  6. '// 技术支持:    rainbowsoft@163.com
  7. '// 程序名称:    
  8. '// 程序版本:    
  9. '// 单元名称:    c_function.asp
  10. '// 开始时间:    2004.07.28
  11. '// 最后修改:    
  12. '// 备    注:    函数模块
  13. '///////////////////////////////////////////////////////////////////////////////
  18. '*********************************************************
  19. ' 目的：    显示错误页面
  20. ' 输入：    id
  21. ' 返回：    无
  22. '*********************************************************
  23. Dim ShowError_Custom
  24. Sub ShowError(id)
  25. If IsEmpty(ShowError_Custom)=False Then
  26. Execute(ShowError_Custom)
  27. Exit Sub
  28. End If
  29. Response.Redirect ZC_BLOG_HOST & "function/c_error.asp?errorid=" & id & "&number=" & Err.Number & "&description=" & Server.URLEncode(Err.Description) & "&source=" & Server.URLEncode(Err.Source) & "&sourceurl="  &Server.URLEncode(Request.ServerVariables("Http_Referer")) 
  30. End Sub
  31. '*********************************************************
  36. '*********************************************************
  37. ' 目的：    XML-RPC显示错误页面
  38. '*********************************************************
  39. Function RespondError(faultCode,faultString)
  41. Dim strXML
  42. Dim strError
  44. strXML="<?xml version=""1.0"" encoding=""UTF-8""?><methodResponse><fault><value><struct><member><name>faultCode</name><value><int>$1</int></value></member><member><name>faultString</name><value><string>$2</string></value></member></struct></value></fault></methodResponse>"
  46. strError=strXML
  47. strError=Replace(strError,"$1",TransferHTML(faultCode,"[html-format]"))
  48. strError=Replace(strError,"$2",TransferHTML(faultString,"[html-format]"))
  50. Response.Clear
  51. Response.BinaryWrite ChrB(&HEF) & ChrB(&HBB) & ChrB(&HBF)
  52. Response.Write strError
  53. Response.End
  55. End Function
  56. '*********************************************************
  61. '*********************************************************
  62. ' 目的：    检查正则式
  63. ' 输入：    id
  64. ' 返回：    成功为True
  65. '*********************************************************
  66. Function CheckRegExp(source,para)
  68. If para="[username]" Then
  69. para="^[.A-Za-z0-9u4e00-u9fa5]+$"
  70. End If
  71. If para="[password]" Then
  72. para="^[a-z0-9]+$"
  73. End If
  74. If para="[email]" Then
  75. para="^([0-9a-zA-Z]([-.w]*[0-9a-zA-Z])*@([0-9a-zA-Z][-w]*.)+[a-zA-Z]*)$"
  76. End If
  77. If para="[homepage]" Then
  78. para="^[a-zA-Z]+://[a-zA-Z0-9-.&?/]+?/*$"
  79. End If
  80. If para="[nojapan]" Then
  81. para="[u3040-u30ff]+"
  82. End If
  83. If para="[guid]" Then
  84. para="^w{8}-w{4}-w{4}-w{4}-w{12}$"
  85. End If
  87. Dim re
  88. Set re = New RegExp
  89. re.Global = True
  90. re.Pattern = para
  91. re.IgnoreCase = False
  92. CheckRegExp = re.Test(source)
  94. End Function
  95. '*********************************************************
  100. '*********************************************************
  101. ' 目的：    检查参数
  102. ' 返回：    出错则转到ShowError(3)
  103. '*********************************************************
  104. Function CheckParameter(byRef source,strType,default)
  106. On Error Resume Next
  108. If strType="int" Then
  110. '数值
  111. If IsNull(source) Then
  112. source=default
  113. ElseIf IsEmpty(source) Then
  114. source=default
  115. ElseIf IsNumeric(source) Then
  116. source=CLng(source)
  117. ElseIf source="" Then
  118. source=default
  119. Else
  120. Call ShowError(3)
  121. End if
  122. If Err.Number<>0 Then Call ShowError(3)
  124. CheckParameter=True
  126. ElseIf  strType="dtm" Then
  128. '日期
  129. If IsNull(source) Then
  130. source=default
  131. ElseIf IsEmpty(source) Then
  132. source=default
  133. ElseIf IsDate(source) Then
  134. source=source
  135. Call FormatDateTime(source,vbLongDate)
  136. Call FormatDateTime(source,vbShortDate)
  137. ElseIf source="" Then
  138. source=default
  139. Else
  140. Call ShowError(3)
  141. End if
  142. If Err.Number<>0 Then Call ShowError(3)
  144. CheckParameter=True
  146. ElseIf strType="sql" Then
  148. 'SQL
  149. If IsNull(source) Or Trim(source)="" Or IsEmpty(source) Then
  150. source=default
  151. Else
  152. source=CStr(Replace(source,Chr(39),Chr(39)&Chr(39)))
  153. End If
  155. ElseIf strType="bool" Then
  157. 'Boolean
  158. source=CBool(source)
  160. If Err.Number<>0 Then
  161. Err.Clear
  162. If IsEmpty(source)=True Then
  163. source=True
  164. Else
  165. source=False
  166. End If
  167. End If
  169. Else
  170. Call ShowError(0)
  171. End If
  173. End Function
  174. '*********************************************************
  179. '*********************************************************
  180. ' 目的：    检查引用
  181. ' 返回：    无
  182. '*********************************************************
  183. Sub CheckReference(strDestination)
  185. Exit Sub
  187. Dim strReferer
  188. strReferer=CStr(Request.ServerVariables("HTTP_REFERER"))
  190. If Instr(strReferer,ZC_BLOG_HOST)=0 Then 
  191. ShowError(5)
  192. End If
  194. End Sub
  195. '*********************************************************
  200. '*********************************************************
  201. ' 目的：    搜索字符串
  202. ' 返回：    
  203. ' 备注:     不区分大小写
  204. '*********************************************************
  205. Function Search(strText,strQuestion)
  207. Dim s
  208. Dim i
  209. Dim j
  211. s=strText
  212. i=Instr(1,s,strQuestion,vbTextCompare)
  213. If i>0 Then
  214. s=Left(s,i+Len(strQuestion)+100)
  215. s=Right(s,Len(strQuestion)+200)
  216. Else
  217. s=""
  218. End If
  220. If s<>"" Then
  221. i=1
  222. Do While InStr(i,s,strQuestion,vbTextCompare)>0
  223. j=InStr(i,s,strQuestion,vbTextCompare)
  224. If Len(s)-j-Len(strQuestion)<0 Then
  225. s=Left(s,j-1) & "<b style='color:#FF6347'>" & strQuestion & "</b>"
  226. Exit Do
  227. Else
  228. s=Left(s,j-1) & "<b style='color:#FF6347'>" & strQuestion & "</b>" & Right(s,Len(s)-j-Len(strQuestion)+1)
  229. End If
  230. i=j+Len("<b style='color:#FF6347'>" & strQuestion & "</b>")-1
  231. If i>=Len(s) Then Exit Do
  232. Loop
  234. End If
  236. If s="" Then
  237. Search=strText
  238. Else
  239. Search=s
  240. End If
  242. End Function
  243. '*********************************************************
  248. '*********************************************************
  249. ' 目的：    检查引用
  250. ' 输入：    SQL值（引用）
  251. ' 返回：    
  252. '*********************************************************
  253. Function FilterSQL(strSQL)
  255. FilterSQL=CStr(Replace(strSQL,chr(39),chr(39)&chr(39)))
  257. End Function
  258. '*********************************************************
  263. '*********************************************************
  264. ' 目的：    检查引用
  265. ' 输入：    
  266. ' 输入：    要替换的字符代号
  267. ' 返回：    
  268. '*********************************************************
  269. Function TransferHTML(ByVal source,para)
  271. Dim objRegExp
  273. '先换"&"
  274. If Instr(para,"[&]")>0 Then  source=Replace(source,"&","&amp;")
  275. If Instr(para,"[<]")>0 Then  source=Replace(source,"<","&lt;")
  276. If Instr(para,"[>]")>0 Then  source=Replace(source,">","&gt;")
  277. If Instr(para,"[""]")>0 Then source=Replace(source,"""","&quot;")
  278. If Instr(para,"[space]")>0 Then source=Replace(source," ","&nbsp;")
  279. If Instr(para,"[enter]")>0 Then
  280. source=Replace(source,vbCrLf,"<br/>")
  281. source=Replace(source,vbLf,"<br/>")
  282. End If
  283. If Instr(para,"[vbCrlf]")>0 And ZC_AUTO_NEWLINE Then 
  285. Set objRegExp=New RegExp
  286. objRegExp.IgnoreCase =True
  287. objRegExp.Global=True
  289. objRegExp.Pattern="((</?form[^n<]*>)|(<select[^n<]*>)|(<textarea[^n<]*>)|(</?option[^n<]*>)|(</?dl[^n<]*>)|(</?dt[^n<]*>)|(</?dd[^n<]*>)|(</?th[^n<]*>)|(</?tr[^n<]*>)|(</?td[^n<]*>)|(</?tbody[^n<]*>)|(</?table[^n<]*>)|(</?hr[^n<]*>)|(</?div[^n<]*>)|(</?ul[^n<]*>)|(</?li[^n<]*>)|(</?ol[^n<]*>)|(</?h1[^n<]*>)|(</?h2[^n<]*>)|(</?h3[^n<]*>)|(</?h4[^n<]*>)|(</?h5[^n<]*>)|(</?h6[^n<]*>)|(</?p[^n<]*>))(x20*(rn|n))"
  291. source= objRegExp.Replace(source,"$1")
  293. objRegExp.Pattern="(rn|n)"
  294. source= objRegExp.Replace(source,"<br/>")
  296. source=Replace(source,"<html>","")
  297. source=Replace(source,"</html>","")
  298. source=Replace(source,"<body>","")
  299. source=Replace(source,"</body>","")
  301. End If
  302. If Instr(para,"[vbTab]")>0 Then source=Replace(source,vbTab,"&nbsp;&nbsp;")
  303. If Instr(para,"[upload]")>0 Then
  304. source=Replace(source,"src=""upload/","src="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/")
  305. source=Replace(source,"href=""upload/","href="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/")
  306. source=Replace(source,"value=""upload/","value="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/")
  307. source=Replace(source,"href=""http://upload/","href="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/")
  308. source=Replace(source,"(this.nextSibling,'upload/","(this.nextSibling,'"& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/")
  310. source=Replace(source,"src=""image/face/","src="""& ZC_BLOG_HOST & "image/face/")
  311. End If
  312. If Instr(para,"[anti-upload]")>0 Then
  313. source=Replace(source,"src="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/","src=""upload/")
  314. source=Replace(source,"href="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/","href=""upload/")
  315. source=Replace(source,"value="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/","value=""upload/")
  316. source=Replace(source,"href="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/","href=""http://upload/")
  317. source=Replace(source,"(this.nextSibling,'"& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/","(this.nextSibling,'upload/")
  319. source=Replace(source,"src="""& ZC_BLOG_HOST & "image/face/","src=""image/face/")
  320. End If
  321. If Instr(para,"[zc_blog_host]")>0 Then
  322. source=Replace(source,"<#ZC_BLOG_HOST#>",ZC_BLOG_HOST)
  323. End If
  324. If Instr(para,"[anti-zc_blog_host]")>0 Then
  325. source=Replace(source,ZC_BLOG_HOST,"<#ZC_BLOG_HOST#>")
  326. End If
  327. If Instr(para,"[no-asp]")>0 Then
  328. source=Replace(source,"<"&"%","&lt;"&"%")
  329. source=Replace(source,"%"&">","%"&"&gt;")
  330. End If
  331. If ZC_COMMENT_NOFOLLOW_ENABLE And Instr(para,"[nofollow]")>0 Then
  332. source=Replace(source,"<a ","<a rel=""nofollow"" ")
  333. End If
  334. If Instr(para,"[nohtml]")>0  Then
  336. Set objRegExp=New RegExp
  337. objRegExp.IgnoreCase =True
  338. objRegExp.Global=True
  339. objRegExp.Pattern="<[^>]*>"
  340. source= objRegExp.Replace(source,"")
  342. End If
  343. If Instr(para,"[filename]")>0  Then
  344. source=Replace(source,"/","")
  345. source=Replace(source,"","")
  346. source=Replace(source,":","")
  347. source=Replace(source,"?","")
  348. source=Replace(source,"*","")
  349. source=Replace(source,"""","")
  350. source=Replace(source,"<","")
  351. source=Replace(source,">","")
  352. source=Replace(source,"|","")
  353. source=Replace(source," ","")
  354. End If
  355. If Instr(para,"[normalname]")>0  Then
  356. source=Replace(source,"$","")
  357. source=Replace(source,"(","")
  358. source=Replace(source,")","")
  359. source=Replace(source,"*","")
  360. source=Replace(source,"+","")
  361. source=Replace(source,",","")
  362. source=Replace(source,"[","")
  363. source=Replace(source,"]","")
  364. source=Replace(source,"{","")
  365. source=Replace(source,"}","")
  366. source=Replace(source,"?","")
  367. source=Replace(source,"","")
  368. source=Replace(source,"^","")
  369. source=Replace(source,"|","")
  370. source=Replace(source,":","")
  371. source=Replace(source,"""","")
  372. source=Replace(source,"'","")
  373. End If
  374. If Instr(para,"[textarea]")>0 Then
  375. 'Set objRegExp=New RegExp
  376. 'objRegExp.IgnoreCase =True
  377. 'objRegExp.Global=True
  378. 'objRegExp.Pattern="(&)([#a-z0-9]{2,10})(;)"
  379. 'source= objRegExp.Replace(source,"&amp;$2$3")
  380. source=Replace(source,"&","&amp;")
  381. source=Replace(source,"%","&#037;")
  382. source=Replace(source,"<","&lt;")
  383. source=Replace(source,">","&gt;")
  384. End If
  385. If ZC_JAPAN_TO_HTML And Instr(para,"[japan-html]")>0 Then
  386. source=Replace(source,"ガ","&#12460;")
  387. source=Replace(source,"ギ","&#12462;")
  388. source=Replace(source,"ア","&#12450;")
  389. source=Replace(source,"ゲ","&#12466;")
  390. source=Replace(source,"ゴ","&#12468;")
  391. source=Replace(source,"ザ","&#12470;")
  392. source=Replace(source,"ジ","&#12472;")
  393. source=Replace(source,"ズ","&#12474;")
  394. source=Replace(source,"ゼ","&#12476;")
  395. source=Replace(source,"ゾ","&#12478;")
  396. source=Replace(source,"ダ","&#12480;")
  397. source=Replace(source,"ヂ","&#12482;")
  398. source=Replace(source,"ヅ","&#12485;")
  399. source=Replace(source,"デ","&#12487;")
  400. source=Replace(source,"ド","&#12489;")
  401. source=Replace(source,"バ","&#12496;")
  402. source=Replace(source,"パ","&#12497;")
  403. source=Replace(source,"ビ","&#12499;")
  404. source=Replace(source,"ピ","&#12500;")
  405. source=Replace(source,"ブ","&#12502;")
  406. source=Replace(source,"ブ","&#12502;")
  407. source=Replace(source,"プ","&#12503;")
  408. source=Replace(source,"ベ","&#12505;")
  409. source=Replace(source,"ペ","&#12506;")
  410. source=Replace(source,"ボ","&#12508;")
  411. source=Replace(source,"ポ","&#12509;")
  412. source=Replace(source,"ヴ","&#12532;")
  413. End If
  414. If ZC_JAPAN_TO_HTML And Instr(para,"[html-japan]")>0 Then
  415. source=Replace(source,"&#12460;","ガ")
  416. source=Replace(source,"&#12462;","ギ")
  417. source=Replace(source,"&#12450;","ア")
  418. source=Replace(source,"&#12466;","ゲ")
  419. source=Replace(source,"&#12468;","ゴ")
  420. source=Replace(source,"&#12470;","ザ")
  421. source=Replace(source,"&#12472;","ジ")
  422. source=Replace(source,"&#12474;","ズ")
  423. source=Replace(source,"&#12476;","ゼ")
  424. source=Replace(source,"&#12478;","ゾ")
  425. source=Replace(source,"&#12480;","ダ")
  426. source=Replace(source,"&#12482;","ヂ")
  427. source=Replace(source,"&#12485;","ヅ")
  428. source=Replace(source,"&#12487;","デ")
  429. source=Replace(source,"&#12489;","ド")
  430. source=Replace(source,"&#12496;","バ")
  431. source=Replace(source,"&#12497;","パ")
  432. source=Replace(source,"&#12499;","ビ")
  433. source=Replace(source,"&#12500;","ピ")
  434. source=Replace(source,"&#12502;","ブ")
  435. source=Replace(source,"&#12502;","ブ")
  436. source=Replace(source,"&#12503;","プ")
  437. source=Replace(source,"&#12505;","ベ")
  438. source=Replace(source,"&#12506;","ペ")
  439. source=Replace(source,"&#12508;","ボ")
  440. source=Replace(source,"&#12509;","ポ")
  441. source=Replace(source,"&#12532;","ヴ")
  442. End If
  443. If Instr(para,"[html-format]")>0 Then
  444. source=Replace(source,"&","&amp;")
  445. source=Replace(source,"<","&lt;")
  446. source=Replace(source,">","&gt;")
  447. source=Replace(source,"""","&quot;")
  448. End If
  449. If Instr(para,"[anti-html-format]")>0 Then
  450. source=Replace(source,"&quot;","""")
  451. source=Replace(source,"&lt;","<")
  452. source=Replace(source,"&gt;",">")
  453. source=Replace(source,"&amp;","&")
  454. End If
  455. If Instr(para,"[wapnohtml]")>0 Then
  456. source=Replace(source,"<br/>",vbCrLf)
  457. source=Replace(source,"<br>",vbCrLf)
  458. Set objRegExp=New RegExp
  459. objRegExp.IgnoreCase =True
  460. objRegExp.Global=True
  461. objRegExp.Pattern="(<[^>]*)|([^<]*>)"
  462. source= objRegExp.Replace(source,"")
  463. objRegExp.Pattern="(rn|n)"
  464. source= objRegExp.Replace(source,"<br/>")
  465. End If
  467. If Instr(para,"[nbsp-br]")>0 Then
  468. Set objRegExp=New RegExp
  469. objRegExp.IgnoreCase =True
  470. objRegExp.Global=True
  471. objRegExp.Pattern="&lt;$|&lt;b$|&lt;br$|&lt;br/$"
  472. source= objRegExp.Replace(source,"")
  473. objRegExp.Pattern="^br/&gt;|^r/&gt;|^/&gt;|^&gt;"
  474. source= objRegExp.Replace(source,"")
  475. objRegExp.Pattern="&lt;br/&gt;"
  476. source= objRegExp.Replace(source,"<br/>")
  477. objRegExp.Pattern="&amp;nbsp;"
  478. source= objRegExp.Replace(source," ")
  479. End If
  481. If Instr(para,"[closehtml]")>0 Then
  482. source=closeHTML(source)
  483. End If
  486. TransferHTML=source
  488. End Function
  489. '*********************************************************
  494. '*********************************************************
  495. ' 目的：   301 Moved
  496. ' 输入：    
  497. ' 返回：    
  498. '*********************************************************
  499. Sub RedirectBy301(strURL)
  501. Response.Clear
  502. Response.Status="301 Moved Permanently"
  503. Response.AddHeader "Location",strURL
  504. Response.End
  506. End Sub
  507. '*********************************************************
  512. '*********************************************************
  513. ' 目的：   Random Number Create
  514. ' 输入：    
  515. ' 返回：    
  516. '*********************************************************
  517. Sub CreateVerifyNumber()
  519. Dim i,j,s,t
  520. Randomize
  522. Dim aryVerifyNumber(10000)
  523. For j=0 To 10000
  524. s=""
  525. For i = 0 To 4
  526. t = Int(Rnd * Len(ZC_VERIFYCODE_STRING))
  527. s= s & Mid(ZC_VERIFYCODE_STRING,t + 1, 1)
  528. Next
  529. aryVerifyNumber(j)=s
  530. Next
  532. Application.Lock
  533. Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")=aryVerifyNumber
  534. Application.UnLock
  536. End Sub
  537. '*********************************************************
  542. '*********************************************************
  543. ' 目的：   Random Number Get
  544. ' 输入：    
  545. ' 返回：    
  546. '*********************************************************
  547. Function GetVerifyNumber()
  549. Randomize
  550. Dim i,j,s,t
  551. Dim aryVerifyNumber
  553. Application.Lock
  554. aryVerifyNumber=Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")
  555. Application.UnLock
  557. If IsEmpty(aryVerifyNumber)=True Or IsArray(aryVerifyNumber)=False Then
  558. Call CreateVerifyNumber()
  559. Application.Lock
  560. aryVerifyNumber=Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")
  561. Application.UnLock
  562. End If
  565. For i=0 To 10000
  566. If (aryVerifyNumber(i)<>"") And (Len(aryVerifyNumber(i))=5) Then 
  567. GetVerifyNumber=aryVerifyNumber(i)
  568. Exit For
  569. End If
  570. Next
  572. aryVerifyNumber(i)=aryVerifyNumber(i)&"-"
  574. If i=5000 Then
  575. For j=5001 To 10000
  576. s=""
  577. For i = 0 To 4
  578. t = Int(Rnd * Len(ZC_VERIFYCODE_STRING))
  579. s= s & Mid(ZC_VERIFYCODE_STRING,t + 1, 1)
  580. Next
  581. aryVerifyNumber(j)=s
  582. Next
  583. End If
  585. If i=10000 Then
  586. For j=0 To 5000
  587. s=""
  588. For i = 0 To 4
  589. t = Int(Rnd * Len(ZC_VERIFYCODE_STRING))
  590. s= s & Mid(ZC_VERIFYCODE_STRING,t + 1, 1)
  591. Next
  592. aryVerifyNumber(j)=s
  593. Next
  594. End If
  596. Application.Lock
  597. Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")=aryVerifyNumber
  598. Application.UnLock
  600. End Function
  601. '*********************************************************
  606. '*********************************************************
  607. ' 目的：   Random Number Check
  608. ' 输入：    
  609. ' 返回：    
  610. '*********************************************************
  611. Function CheckVerifyNumber(ByVal strNumber)
  613. Dim i,j,s,t
  614. Dim aryVerifyNumber
  616. Application.Lock
  617. aryVerifyNumber=Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")
  618. Application.UnLock
  620. If IsEmpty(aryVerifyNumber) Then Exit Function
  622. strNumber=UCase(strNumber)
  624. For j=0 To 10000
  626. If aryVerifyNumber(j)=strNumber & "-" Then
  628. Randomize
  629. s=""
  630. For i = 0 To 4
  631. t = Int(Rnd * Len(ZC_VERIFYCODE_STRING))
  632. s= s & Mid(ZC_VERIFYCODE_STRING,t + 1, 1)
  633. Next
  634. aryVerifyNumber(j)=s
  636. Application.Lock
  637. Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")=aryVerifyNumber
  638. Application.UnLock
  640. CheckVerifyNumber=True
  642. Exit Function
  644. End If
  646. Next
  648. End Function
  649. '*********************************************************
  654. '*********************************************************
  655. ' 目的：    UBB
  656. ' 输入：    
  657. ' 输入：    
  658. ' 返回：    
  659. '*********************************************************
  660. Function UBBCode(ByVal strContent,strType)
  662. Dim objRegExp
  663. Set objRegExp=new RegExp
  664. objRegExp.IgnoreCase =True
  665. objRegExp.Global=True
  667. If ZC_UBB_LINK_ENABLE And Instr(strType,"[link]")>0 Then
  669. objRegExp.Pattern="([URL])(([a-zA-Z0-9]+?)://[^ :()fnrtv]+?)([/URL])"
  670. strContent= objRegExp.Replace(strContent,"<a href=""$2"" target=""_blank"">$2</a>")
  672. objRegExp.Pattern="([URL])([^ :()fnrtv]+?)([/URL])"
  673. strContent= objRegExp.Replace(strContent,"<a href=""http://$2"" target=""_blank"">$2</a>")
  675. objRegExp.Pattern="([URL=)(([a-zA-Z0-9]+?)://[^ :()fnrtv]+?)(])(.+?)([/URL])"
  676. strContent= objRegExp.Replace(strContent,"<a href=""$2"" target=""_blank"">$5</a>")
  678. objRegExp.Pattern="([URL=)([^ :()fnrtv]+?)(])(S+?)([/URL])"
  679. strContent= objRegExp.Replace(strContent,"<a href=""http://$2"" target=""_blank"">$4</a>")
  681. End If
  684. If ZC_UBB_LINK_ENABLE And Instr(strType,"[email]")>0 Then
  686. objRegExp.Pattern="([EMAIL])(S+@S+?)([/EMAIL])"
  687. strContent= objRegExp.Replace(strContent,"<a href=""mailto:$2"" >$2</a>")
  689. objRegExp.Pattern="([EMAIL=)(S+@S+?)(])(.+?)([/EMAIL])"
  690. strContent= objRegExp.Replace(strContent,"<a href=""mailto:$2"">$4</a>")
  692. End If
  695. If ZC_UBB_FONT_ENABLE And Instr(strType,"[font]")>0 Then
  697. objRegExp.Pattern="([I])([u0000-uffff]+?)([/I])"
  698. strContent=objRegExp.Replace(strContent,"<i>$2</i>")
  700. objRegExp.Pattern="([B])([u0000-uffff]+?)([/B])"
  701. strContent=objRegExp.Replace(strContent,"<b>$2</b>")
  703. objRegExp.Pattern="([U])([u0000-uffff]+?)([/U])"
  704. strContent=objRegExp.Replace(strContent,"<u>$2</u>")
  706. objRegExp.Pattern="([S])([u0000-uffff]+?)([/S])"
  707. strContent=objRegExp.Replace(strContent,"<s>$2</s>")
  709. objRegExp.Pattern="([QUOTE])([u0000-uffff]+?)([/QUOTE])"
  710. strContent=objRegExp.Replace(strContent,"<blockquote><div class=""quote"">$2"&"</div></blockquote>")
  712. objRegExp.Pattern="([QUOTE=)(.+?)(])([u0000-uffff]+?)([/QUOTE])"
  713. strContent= objRegExp.Replace(strContent,"<blockquote><div class=""quote quote2""><div class=""quote-title"">"&ZC_MSG153&" $2</div>$4"&"</div></blockquote>")
  715. objRegExp.Pattern="([REVERT=)(.+?)(])([u0000-uffff]+?)([/REVERT])"
  716. strContent= objRegExp.Replace(strContent,"<blockquote><div class=""quote quote3""><div class=""quote-title"">$2</div>$4</div></blockquote>")
  718. End If
  721. If ZC_UBB_CODE_ENABLE And Instr(strType,"[code]")>0 Then
  723. Dim strCode
  724. Dim Match, Matches
  726. strContent =Replace(strContent,vbLf,"")
  728. '[CODELITE]
  729. objRegExp.Pattern="([CODE_LITE])(.+?)([/CODE_LITE])"
  730. Set Matches = objRegExp.Execute(strContent)
  732. For Each Match in Matches
  734. strCode=Match
  735. strCode = TransferHTML(strCode,"[<][>][space][vbTab]")
  736. strCode=Replace(strCode,vbCr,"<br/>")
  737. strContent =Replace(strContent,Match,strCode)
  739. objRegExp.Global=False
  741. objRegExp.Pattern="([CODE_LITE](<br/>)?)(.+?)([/CODE_LITE])"
  742. strContent=objRegExp.Replace(strContent,"<p class=""code""><code>$3</code></p>")
  744. objRegExp.Global=True
  746. Next
  747. Set Matches = Nothing
  749. '[CODE]
  750. objRegExp.Pattern="([CODE])(.+?)([/CODE])"
  751. Set Matches = objRegExp.Execute(strContent)
  753. For Each Match in Matches
  755. strCode=Match
  756. strCode = TransferHTML(strCode,"[<][>][space][vbTab]")
  757. strCode = Replace(strCode,vbCr,Chr(8)&Chr(11)&Chr(9)&Chr(12))
  758. strContent =Replace(strContent,Match,strCode)
  761. objRegExp.Global=False
  763. objRegExp.Pattern="([CODE])(.+?)([/CODE])"
  764. strContent=objRegExp.Replace(strContent,"<textarea class=""code"" rows=""10"" cols=""50"">$2</textarea>")
  766. objRegExp.Global=True
  768. Next
  769. Set Matches = Nothing
  771. strContent =Replace(strContent,vbCr,vbCrLf)
  772. strContent =Replace(strContent,Chr(8)&Chr(11)&Chr(9)&Chr(12),vbCr)
  774. End If
  777. If ZC_UBB_FACE_ENABLE And Instr(strType,"[face]")>0 Then
  779. objRegExp.Pattern="([F])(.+?)([/F])"
  780. strContent= objRegExp.Replace(strContent,"<img src="""& ZC_BLOG_HOST &"image/face/$2.gif"" style=""padding:2px;border:0;"" width="""&ZC_EMOTICONS_FILESIZE&""" title=""$2"" alt=""$2"" />")
  782. End If
  785. If ZC_UBB_IMAGE_ENABLE And Instr(strType,"[image]")>0 Then
  786. '[img]
  788. objRegExp.Pattern="([IMG=)([0-9]*),([0-9]*),([^n[]*)(])(.+?)([/IMG])"
  789. strContent= objRegExp.Replace(strContent,"<img src=""$6"" alt=""$4"" title=""$4"" width=""$2"" height=""$3""/>")
  791. objRegExp.Pattern="([IMG=)([0-9]*),([^n[]*)(])(.+?)([/IMG])"
  792. strContent= objRegExp.Replace(strContent,"<img src=""$5"" alt=""$3"" title=""$3"" width=""$2""/>")
  794. objRegExp.Pattern="([IMG=)([0-9]*)(])(.+?)([/IMG])"
  795. strContent= objRegExp.Replace(strContent,"<img src=""$4"" alt="""" title="""" width=""$2""/>")
  797. objRegExp.Pattern="([IMG])(.+?)([/IMG])"
  798. strContent= objRegExp.Replace(strContent,"<img onload=""ResizeImage(this,"&ZC_IMAGE_WIDTH&")"" src=""$2"" alt="""" title=""""/>")
  801. objRegExp.Pattern="([IMG_LEFT=)([0-9]*),([0-9]*),([^n[]*)(])(.+?)([/IMG_LEFT])"
  802. strContent= objRegExp.Replace(strContent,"<img class=""float-left"" style=""float:left"" src=""$6"" alt=""$4"" title=""$4"" width=""$2"" height=""$3""/>")
  804. objRegExp.Pattern="([IMG_LEFT=)([0-9]*),([^n[]*)(])(.+?)([/IMG_LEFT])"
  805. strContent= objRegExp.Replace(strContent,"<img class=""float-left"" style=""float:left"" src=""$5"" alt=""$3"" title=""$3"" width=""$2""/>")
  807. objRegExp.Pattern="([IMG_LEFT=)([0-9]*)(])(.+?)([/IMG_LEFT])"
  808. strContent= objRegExp.Replace(strContent,"<img class=""float-left"" style=""float:left"" src=""$4"" alt="""" title="""" width=""$2""/>")
  810. objRegExp.Pattern="([IMG_LEFT])(.+?)([/IMG_LEFT])"
  811. strContent= objRegExp.Replace(strContent,"<img onload=""ResizeImage(this,"&ZC_IMAGE_WIDTH&")"" class=""float-left"" style=""float:left"" src=""$2"" alt="""" title=""""/>")
  814. objRegExp.Pattern="([IMG_RIGHT=)([0-9]*),([0-9]*),(.*)(])(.+?)([/IMG_RIGHT])"
  815. strContent= objRegExp.Replace(strContent,"<img class=""float-right"" style=""float:right"" src=""$6"" alt=""$4"" title=""$4"" width=""$2"" height=""$3""/>")
  817. objRegExp.Pattern="([IMG_RIGHT=)([0-9]*),(.*)(])(.+?)([/IMG_RIGHT])"
  818. strContent= objRegExp.Replace(strContent,"<img class=""float-right"" style=""float:right"" src=""$5"" alt=""$3"" title=""$3"" width=""$2""/>")
  820. objRegExp.Pattern="([IMG_RIGHT=)([0-9]*)(])(.+?)([/IMG_RIGHT])"
  821. strContent= objRegExp.Replace(strContent,"<img class=""float-right"" style=""float:right"" src=""$4"" alt="""" title="""" width=""$2""/>")
  823. objRegExp.Pattern="([IMG_RIGHT])(.+?)([/IMG_RIGHT])"
  824. strContent= objRegExp.Replace(strContent,"<img onload=""ResizeImage(this,"&ZC_IMAGE_WIDTH&")"" class=""float-right"" style=""float:right"" src=""$2"" alt="""" title=""""/>")
  828. End If
  831. If ZC_UBB_FLASH_ENABLE And Instr(strType,"[flash]")>0 Then
  832. '[flash]
  834. objRegExp.Pattern="([FLASH=)([0-9]*),([0-9]*),([a-z]*)(])(.+?)([/FLASH])"
  835. strContent= objRegExp.Replace(strContent,"<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=""$2"" height=""$3""><param name=""movie"" value=""$6""><param name=""quality"" value=""high""><param name=""play"" value=""$4""><embed src=""$6"" quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=""$2"" height=""$3"" play=""$4""></embed></object>")
  837. End If
  841. If ZC_UBB_TYPESET_ENABLE And Instr(strType,"[typeset]")>0 Then
  843. objRegExp.Pattern="([ALIGN-CENTER])([u0000-uffff]+?)([/ALIGN-CENTER])"
  844. strContent=objRegExp.Replace(strContent,"<div style=""margin:10px 0 10px 0;text-align:center;"">$2</div>")
  846. objRegExp.Pattern="([ALIGN-LELT])([u0000-uffff]+?)([/ALIGN-LELT])"
  847. strContent=objRegExp.Replace(strContent,"<div style=""margin:10px 0 10px 0;text-align:left;"">$2</div>")
  849. objRegExp.Pattern="([ALIGN-RIGHT])([u0000-uffff]+?)([/ALIGN-RIGHT])"
  850. strContent=objRegExp.Replace(strContent,"<div style=""margin:10px 0 10px 0;text-align:right;"">$2</div>")
  852. objRegExp.Pattern="([HR])([u0000-uffff]?)([/HR])"
  853. strContent=objRegExp.Replace(strContent,"<hr/>")
  855. objRegExp.Pattern="([FONT-FACE=)([a-zx20]*)(])([u0000-uffff]+?)([/FONT-FACE])"
  856. strContent=objRegExp.Replace(strContent,"<font face=""$2"">$4</font>")
  858. objRegExp.Pattern="([FACE=)([a-zx20]*)(])([u0000-uffff]+?)([/FACE])"
  859. strContent=objRegExp.Replace(strContent,"<font face=""$2"">$4</font>")
  861. objRegExp.Pattern="([FONT-SIZE=)([1-7]*)(])([u0000-uffff]+?)([/FONT-SIZE])"
  862. strContent=objRegExp.Replace(strContent,"<font size=""$2"">$4</font>")
  864. objRegExp.Pattern="([SIZE=)([1-7]*)(])([u0000-uffff]+?)([/SIZE])"
  865. strContent=objRegExp.Replace(strContent,"<font size=""$2"">$4</font>")
  867. objRegExp.Pattern="([FONT-COLOR=)([#0-9a-z]*)(])([u0000-uffff]+?)([/FONT-COLOR])"
  868. strContent=objRegExp.Replace(strContent,"<font color=""$2"">$4</font>")
  870. objRegExp.Pattern="([COLOR=)([#0-9a-z]*)(])([u0000-uffff]+?)([/COLOR])"
  871. strContent=objRegExp.Replace(strContent,"<font color=""$2"">$4</font>")
  873. End If
  877. If ZC_UBB_MEDIA_ENABLE And Instr(strType,"[media]")>0 Then
  879. '[WMA]
  880. objRegExp.Pattern="([WMA=)([a-z]*)(])(.+?)([/WMA])"
  881. strContent= objRegExp.Replace(strContent,"<object classid=""clsid:22D6F312-B0F6-11D0-94AB-0080C74C7E95"" height=""68"" width=""350""><param name=""ShowStatusBar"" value=""-1""><param name=""AutoStart"" value=""$2""><param name=""Filename"" value=""$4""><embed type=""application/x-mplayer2"" pluginspage=""http://www.microsoft.com/Windows/MediaPlayer/"" src=""$4"" autostart=""$2"" width=""350"" height=""45""></embed></object>")
  883. objRegExp.Pattern="([WMA])(.+?)([/WMA])"
  884. strContent= objRegExp.Replace(strContent,"<object classid=""clsid:22D6F312-B0F6-11D0-94AB-0080C74C7E95"" height=""68"" width=""350""><param name=""ShowStatusBar"" value=""-1""><param name=""AutoStart"" value=""true""><param name=""Filename"" value=""$2""><embed type=""application/x-mplayer2"" pluginspage=""http://www.microsoft.com/Windows/MediaPlayer/"" src=""$2"" autostart=""true"" width=""350"" height=""45""></embed></object>")
  886. '[WMV]
  887. objRegExp.Pattern="([WMV=)([0-9]*),([0-9]*),([a-z]*)(])(.+?)([/WMV])"
  888. strContent= objRegExp.Replace(strContent,"<object classid=""clsid:22D6F312-B0F6-11D0-94AB-0080C74C7E95""  width=""$2"" height=""$3""><param name=""ShowStatusBar"" value=""-1""><param name=""AutoStart"" value=""$4""><param name=""Filename"" value=""$6""><embed type=""application/x-mplayer2"" pluginspage=""http://www.microsoft.com/Windows/MediaPlayer/"" src=""$6"" autostart=""$4""></embed></object>")
  890. objRegExp.Pattern="([WMV])(.+?)([/WMV])"
  891. strContent= objRegExp.Replace(strContent,"<object classid=""clsid:22D6F312-B0F6-11D0-94AB-0080C74C7E95""><param name=""ShowStatusBar"" value=""-1""><param name=""AutoStart"" value=""true""><param name=""Filename"" value=""$2""><embed type=""application/x-mplayer2"" pluginspage=""http://www.microsoft.com/Windows/MediaPlayer/"" src=""$2"" autostart=""true""></embed></object>")
  893. '[RMV]
  894. objRegExp.Pattern="([RM=)([0-9]*),([0-9]*),([a-z]*)(])(.+?)([/RM])"
  895. strContent= objRegExp.Replace(strContent,"<object classid=""clsid:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA"" width=""$2"" height=""$3""><param name=""src"" value=""$6""><param name=""controls"" value=""imagewindow""><param name=""console"" value=""one""><param name=""AutoStart"" value=""$4""><embed src=""$6"" type=""audio/x-pn-realaudio-plugin"" width=""$2"" height=""$3"" nojava=""true"" controls=""imagewindow,ControlPanel,StatusBar"" console=""one"" autostart=""$4""></object>")
  897. objRegExp.Pattern="([RM])(.+?)([/RM])"
  898. strContent= objRegExp.Replace(strContent,"<object classid=""clsid:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA""><param name=""src"" value=""$2""><param name=""controls"" value=""imagewindow""><param name=""console"" value=""one""><param name=""AutoStart"" value=""true""><embed src=""$2"" type=""audio/x-pn-realaudio-plugin"" nojava=""true"" controls=""imagewindow,ControlPanel,StatusBar"" console=""one"" autostart=""true""></embed></object>")
  900. '[RA]
  901. objRegExp.Pattern="([RA=)([a-z]*)(])(.+?)([/RA])"
  902. strContent= objRegExp.Replace(strContent,"<object classid=""clsid:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA"" width=""350"" height=""36""><param name=""src"" value=""$4""><param name=""controls"" value=""ControlPanel""><param name=""console"" value=""one""><param name=""AutoStart"" value=""$2""><embed src=""$4"" type=""audio/x-pn-realaudio-plugin"" nojava=""true"" controls=""ControlPanel,StatusBar"" console=""one"" autostart=""$2"" width=""350"" height=""36""></embed></object>")
  904. objRegExp.Pattern="([RA])(.+?)([/RA])"
  905. strContent= objRegExp.Replace(strContent,"<object classid=""clsid:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA"" width=""350"" height=""36""><param name=""src"" value=""$2""><param name=""controls"" value=""ControlPanel""><param name=""console"" value=""one""><param name=""AutoStart"" value=""true""><embed src=""$2"" type=""audio/x-pn-realaudio-plugin"" nojava=""true"" controls=""ControlPanel,StatusBar"" console=""one"" autostart=""true"" width=""350"" height=""36""></embed></object>")
  907. '[QT]
  908. objRegExp.Pattern="([QT=)([0-9]*),([0-9]*),([a-z]*)(])(.+?)([/QT])"
  909. strContent= objRegExp.Replace(strContent,"<object classid=""clsid:02BF25D5-8C17-4B23-BC80-D3488ABDDC6B"" codebase=""http://www.apple.com/qtactivex/qtplugin.cab"" width=""$2"" height=""$3"" ><param name=""src"" value=""$6"" ><param name=""autoplay"" value=""$4"" ><embed  src=""qtmimetype.pntg"" type=""image/x-macpaint"" pluginspage=""http://www.apple.com/quicktime/download"" qtsrc=""$6"" width=""$2"" height=""$3"" autoplay=""$4"" ></embed></object>")
  911. objRegExp.Pattern="([QT])(.+?)([/QT])"
  912. strContent= objRegExp.Replace(strContent,"<object classid=""clsid:02BF25D5-8C17-4B23-BC80-D3488ABDDC6B"" codebase=""http://www.apple.com/qtactivex/qtplugin.cab"" ><param name=""src"" value=""$2"" ><param name=""autoplay"" value=""true"" ><embed  src=""qtmimetype.pntg"" type=""image/x-macpaint"" pluginspage=""http://www.apple.com/quicktime/download"" qtsrc=""$2"" autoplay=""true"" ></embed></object>")
  914. '[MEDIA]
  915. objRegExp.Pattern="([MEDIA=)([a-z]*),([0-9]*),([0-9]*)(])(.+?)([/MEDIA])"
  916. strContent= objRegExp.Replace(strContent,"<div class=""media""><a href="""" onclick=""javascript:ShowMedia(this.nextSibling,'$6','$2',$3,$4);return(false);"">"& ZC_MSG103 &"</a><div class=""media-object""></div></div>")
  918. objRegExp.Pattern="([MEDIA=)([0-9]*),([0-9]*)(])(.+?)([/MEDIA])"
  919. strContent= objRegExp.Replace(strContent,"<div class=""media""><a href="""" onclick=""javascript:ShowMedia(this.nextSibling,'$5','AUTO',$2,$3);return(false);"">"& ZC_MSG103 &"</a><div class=""media-object""></div></div>")
  921. objRegExp.Pattern="([MEDIA])(.+?)([/MEDIA])"
  922. strContent= objRegExp.Replace(strContent,"<div class=""media""><a href="""" onclick=""javascript:ShowMedia(this.nextSibling,'$2','AUTO',400,300);return(false);"">"& ZC_MSG103 &"</a><div class=""media-object""></div></div>")
  925. End If
  929. If ZC_UBB_AUTOLINK_ENABLE And Instr(strType,"[autolink]")>0 Then
  931. objRegExp.Pattern="(^|rn|n)((http|https|ftp|mailto|gopher|news|telnet|mms|rtsp|ed2k|tencent|nfcall|dic|pig2pig|callto|exeem|ymsgr|thunder|p4p|pplive|synacast|ppstream|feed|wangwang|qqtv|rssfeed|msnim|chrome|file|ppg|thunder):{1}/{0,2}[^<>fnrtv]+?)(rn|n|$)"
  932. strContent=objRegExp.Replace(strContent,vbCrlf & "<a href=""$2""  target=""_blank"">$2</a>" & vbCrlf)
  934. objRegExp.Pattern="(^|rn|n)((http|https|ftp|mailto|gopher|news|telnet|mms|rtsp|ed2k|tencent|nfcall|dic|pig2pig|callto|exeem|ymsgr|thunder|p4p|pplive|synacast|ppstream|feed|wangwang|qqtv|rssfeed|msnim|chrome|file|ppg|thunder):{1}/{0,2}[^<>fnrtv]+?)(rn|n|$)"
  935. strContent=objRegExp.Replace(strContent,vbCrlf & "<a href=""$2""  target=""_blank"">$2</a>" & vbCrlf)
  937. End If
  940. If ZC_UBB_AUTOKEY_ENABLE And Instr(strType,"[key]")>0 Then
  942. Dim i,j
  944. If IsArray(KeyWords) Then
  945. For i=Lbound(KeyWords,2) To Ubound(KeyWords,2)
  947. objRegExp.Pattern="((<.*)("&KeyWords(1,i)&")(.*>))|((<a.*)("&KeyWords(1,i)&")(/a>))"
  949. Set Matches = objRegExp.Execute(strContent)
  950. For Each Match in Matches
  951. strContent=Replace(strContent,Match,vbVerticalTab & vbTab & vbVerticalTab)
  952. Next
  954. strContent=Replace(strContent,KeyWords(1,i),"<a href="""& KeyWords(2,i) &""" target=""_blank"">"& KeyWords(1,i) &"</a>")
  957. For Each Match in Matches
  958. strContent=Replace(strContent,vbVerticalTab & vbTab & vbVerticalTab,Match,1,1)
  959. Next
  960. Set Matches = Nothing
  962. Next
  963. End If
  965. End If
  968. If ZC_UBB_LINK_ENABLE And Instr(strType,"[link-antispam]")>0 Then
  970. Dim Match2, Matches2 ,strCode2
  972. objRegExp.Pattern="(href="".+?"")"
  973. Set Matches2 = objRegExp.Execute(strContent)
  975. For Each Match2 in Matches2
  976. strCode2=Match2
  977. strCode2=Left(strCode2,Len(strCode2)-1)
  978. strCode2=Right(strCode2,Len(strCode2)-6)
  979. strCode2=URLEncodeForAntiSpam(strCode2)
  980. strContent =Replace(strContent,Match2,"href=""" & strCode2 & """")
  981. Next
  982. Set Matches2 = Nothing
  984. End If
  987. Set objRegExp=Nothing
  988. UBBCode=strContent
  990. End Function
  991. '*********************************************************
  996. '*********************************************************
  997. ' 目的：    Save Text to File
  998. ' 输入：    
  999. ' 输入：    
  1000. ' 返回：    
  1001. '*********************************************************
  1002. Function SaveToFile(strFullName,strContent,strCharset,bolRemoveBOM)
  1004. On Error Resume Next
  1006. Dim objStream
  1008. Set objStream = Server.CreateObject("ADODB.Stream")
  1009. With objStream
  1010. .Type = adTypeText
  1011. .Mode = adModeReadWrite
  1012. .Open
  1013. .Charset = strCharset
  1014. .Position = objStream.Size
  1015. .WriteText = strContent
  1016. .SaveToFile strFullName,adSaveCreateOverWrite
  1017. .Close
  1018. End With
  1019. Set objStream = Nothing
  1021. If bolRemoveBOM Then
  1022. If strContent<>"" And ZC_STATIC_TYPE="shtml" Then
  1023. Call RemoveBOM(strFullName)
  1024. End If
  1025. End If
  1027. Err.Clear
  1029. End Function
  1030. '*********************************************************
  1035. '*********************************************************
  1036. ' 目的：    Load Text form File
  1037. ' 输入：    
  1038. ' 输入：    
  1039. ' 返回：    
  1040. '*********************************************************
  1041. Function LoadFromFile(strFullName,strCharset)
  1043. On Error Resume Next
  1045. Dim objStream
  1047. Set objStream = Server.CreateObject("ADODB.Stream")
  1048. With objStream
  1049. .Type = adTypeText
  1050. .Mode = adModeReadWrite
  1051. .Open
  1052. .Charset = strCharset
  1053. .Position = objStream.Size
  1054. .LoadFromFile strFullName
  1055. LoadFromFile=.ReadText
  1056. .Close
  1057. End With
  1058. Set objStream = Nothing
  1060. Err.Clear
  1062. End Function
  1063. '*********************************************************
  1068. '*********************************************************
  1069. ' 目的：    Remove BOM from UTF-8
  1070. '*********************************************************
  1071. Function RemoveBOM(strFullName)
  1073. On Error Resume Next
  1075. Dim objStream
  1076. Dim strContent
  1078. Set objStream = Server.CreateObject("ADODB.Stream")
  1079. With objStream
  1080. .Type = adTypeBinary
  1081. .Mode = adModeReadWrite
  1082. .Open
  1083. .Position = objStream.Size
  1084. .LoadFromFile strFullName
  1085. .Position = 3
  1086. strContent=.Read
  1087. .Close
  1088. End With
  1089. Set objStream = NoThing
  1091. Set objStream = Server.CreateObject("ADODB.Stream")
  1092. With objStream
  1093. .Type = adTypeBinary
  1094. .Mode = adModeReadWrite
  1095. .Open
  1096. .Position = objStream.Size
  1097. .Write = strContent
  1098. .SaveToFile strFullName,adSaveCreateOverWrite
  1099. .Close
  1100. End With
  1101. Set objStream = Nothing
  1103. Err.Clear
  1105. End Function
  1106. '*********************************************************
  1111. '*********************************************************
  1112. ' 目的：    Save Value For Setting
  1113. '*********************************************************
  1114. Function SaveValueForSetting(ByRef strContent,bolConst,strTypeVar,strItem,strValue)
  1116. Dim i,j,s,t
  1117. Dim strConst
  1118. Dim objRegExp
  1120. If bolConst=True Then strConst="Const"
  1122. Set objRegExp=New RegExp
  1123. objRegExp.IgnoreCase =True
  1124. objRegExp.Global=True
  1126. strValue=TransferHTML(strValue,"[no-asp]")
  1128. If strTypeVar="String" Then
  1130. strValue=Replace(strValue,"""","""""")
  1131. strValue=""""& strValue &""""
  1133. objRegExp.Pattern="(^|rn|n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))(.+?)(rn|n|$)"
  1134. If objRegExp.Test(strContent)=True Then
  1135. strContent=objRegExp.Replace(strContent,"$1$2"& strValue &"$8")
  1136. SaveValueForSetting=True
  1137. Exit Function
  1138. End If
  1140. End If
  1142. If strTypeVar="Boolean" Then
  1144. strValue=Trim(strValue)
  1145. If LCase(strValue)="true" Then
  1146. strValue="True"
  1147. Else
  1148. strValue="False"
  1149. End If
  1151. If objRegExp.Test(strContent)=True Then
  1152. objRegExp.Pattern="(^|rn|n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([a-z]+)( *)(rn|n|$)"
  1153. strContent=objRegExp.Replace(strContent,"$1$2"& strValue &"$9")
  1154. SaveValueForSetting=True
  1155. Exit Function
  1156. End If
  1159. End If
  1161. If strTypeVar="Numeric" Then
  1163. strValue=Trim(strValue)
  1164. If IsNumeric(strValue)=False Then
  1165. strValue=0
  1166. End If
  1168. If objRegExp.Test(strContent)=True Then
  1169. objRegExp.Pattern="(^|rn|n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([0-9.]+)( *)(rn|n|$)"
  1170. strContent=objRegExp.Replace(strContent,"$1$2"& strValue &"$9")
  1171. SaveValueForSetting=True
  1172. Exit Function
  1173. End If
  1175. End If
  1177. SaveValueForSetting=False
  1179. End Function
  1180. '*********************************************************
  1185. '*********************************************************
  1186. ' 目的：    Load Value For Setting
  1187. '*********************************************************
  1188. Function LoadValueForSetting(strContent,bolConst,strTypeVar,strItem,ByRef strValue)
  1190. Dim i,j,s,t
  1191. Dim strConst
  1192. Dim objRegExp
  1193. Dim Matches,Match
  1195. If bolConst=True Then strConst="Const"
  1197. Set objRegExp=New RegExp
  1198. objRegExp.IgnoreCase =True
  1199. objRegExp.Global=True
  1202. If strTypeVar="String" Then
  1204. objRegExp.Pattern="(^|rn|n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))(.+?)(rn|n|$)"
  1205. Set Matches = objRegExp.Execute(strContent)
  1206. If Matches.Count=1 Then
  1208. t=Matches(0).Value
  1209. t=Replace(t,VbCrlf,"")
  1210. t=Replace(t,Vblf,"")
  1211. objRegExp.Pattern="( *)""(.*)""( *)($)"
  1212. Set Matches = objRegExp.Execute(t)
  1214. If Matches.Count>0 Then
  1216. s=Trim(Matches(0).Value)
  1217. s=Mid(s,2,Len(s)-2)
  1218. s=Replace(s,"""""","""")
  1219. strValue=s
  1221. LoadValueForSetting=True
  1222. Exit Function
  1224. End If
  1225. End If
  1227. End If
  1229. If strTypeVar="Boolean" Then
  1231. objRegExp.Pattern="(^|rn|n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([a-z]+)( *)(rn|n|$)"
  1232. Set Matches = objRegExp.Execute(strContent)
  1233. If Matches.Count=1 Then
  1234. t=Matches(0).Value
  1235. t=Replace(t,VbCrlf,"")
  1236. t=Replace(t,Vblf,"")
  1237. objRegExp.Pattern="( *)((True)|(False))( *)($)"
  1238. Set Matches = objRegExp.Execute(t)
  1240. If Matches.Count>0 Then
  1242. s=Trim(Matches(0).Value)
  1243. s=LCase(Matches(0).Value)
  1244. If InStr(s,"true")>0 Then
  1245. strValue=True
  1246. ElseIf InStr(s,"false")>0 Then
  1247. strValue=False
  1248. End If
  1250. LoadValueForSetting=True
  1251. Exit Function
  1253. End If
  1254. End If
  1256. End If
  1258. If strTypeVar="Numeric" Then
  1260. objRegExp.Pattern="(^|rn|n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([0-9.]+)( *)(rn|n|$)"
  1261. Set Matches = objRegExp.Execute(strContent)
  1262. If Matches.Count=1 Then
  1263. t=Matches(0).Value
  1264. t=Replace(t,VbCrlf,"")
  1265. t=Replace(t,Vblf,"")
  1266. objRegExp.Pattern="( *)([0-9.]+)( *)($)"
  1267. Set Matches = objRegExp.Execute(t)
  1269. If Matches.Count>0 Then
  1271. s=Trim(Matches(0).Value)
  1272. If IsNumeric(s)=True Then
  1274. strValue=s
  1276. LoadValueForSetting=True
  1277. Exit Function
  1279. End If
  1281. End If
  1282. End If
  1284. End If
  1286. LoadValueForSetting=False
  1288. End Function
  1289. '*********************************************************
  1294. '*********************************************************
  1295. ' 目的：    
  1296. '*********************************************************
  1297. Function IsObjInstalled(strClassString)
  1298. On Error Resume Next
  1299. IsObjInstalled = False
  1300. Err = 0
  1301. Dim xTestObj
  1302. Set xTestObj = Server.CreateObject(strClassString)
  1303. If 0 = Err Then IsObjInstalled = True
  1304. Set xTestObj = Nothing
  1305. Err = 0
  1306. End Function
  1307. '*********************************************************
  1312. '*********************************************************
  1313. ' 目的：    
  1314. '*********************************************************
  1315. Function URLEncodeForAntiSpam(strUrl)
  1317. Dim i,s
  1318. For i =1 To Len(strUrl)
  1319. s=s & Mid(strUrl,i,1) & CStr(Int((10 * Rnd)))
  1320. Next
  1321. URLEncodeForAntiSpam=ZC_BLOG_HOST & "function/c_urlredirect.asp?url=" & Server.URLEncode(s)
  1323. End Function
  1324. '*********************************************************
  1329. '*********************************************************
  1330. ' 目的：    
  1331. '*********************************************************
  1332. Function URLDecodeForAntiSpam(strUrl)
  1334. Dim i,s
  1335. For i =1 To Len(strUrl) Step 2
  1336. s=s & Mid(strUrl,i,1)
  1337. Next
  1338. If CheckRegExp(s,"[homepage]")=False Then s=""
  1340. URLDecodeForAntiSpam=s
  1342. End Function
  1343. '*********************************************************
  1348. '*********************************************************
  1349. ' 目的：    
  1350. '*********************************************************
  1351. Function GetTime(t)
  1353.         GetTime=DateAdd("h", -(ZC_HOST_TIME_ZONE / 100) + (ZC_TIME_ZONE / 100) , t)
  1355. End Function
  1356. '*********************************************************
  1361. '*********************************************************
  1362. '目的：自动闭合HTML
  1363. '*********************************************************
  1364. Function closeHTML(strContent)
  1366.   Dim arrTags,i,OpenPos,ClosePos,re,strMatchs,j,Match
  1367. Set re=new RegExp
  1368. re.IgnoreCase =True
  1369. re.Global=True
  1370.     arrTags=array("p","div","span","table","ul","font","b","u","i","h1","h2","h3","h4","h5","h6")
  1371.   For i=0 To ubound(arrTags)
  1372.    OpenPos=0
  1373.    ClosePos=0
  1374.    
  1375.    re.Pattern="<"+arrTags(i)+"( [^<>]+|)>"
  1376.    Set strMatchs=re.Execute(strContent)
  1377.    For Each Match In strMatchs
  1378.     OpenPos=OpenPos+1
  1379.    Next
  1380.    re.Pattern="</"+arrTags(i)+">"
  1381.    Set strMatchs=re.Execute(strContent)
  1382.    For Each Match In strMatchs
  1383.     ClosePos=ClosePos+1
  1384.    Next
  1385.    For j=1 To OpenPos-ClosePos
  1386.       strContent=strContent+"</"+arrTags(i)+">"
  1387.    Next
  1388.   Next
  1389.   closeHTML=strContent
  1391. End Function 
  1392. '*********************************************************
  1397. '*********************************************************
  1398. ' 目的：三态
  1399. '*********************************************************
  1400. Function IIf(ByVal expr,ByVal  truepart,ByVal  falsepart)
  1401. If expr=True Then
  1402. IIf=truepart
  1403. Else
  1404. IIf=falsepart
  1405. End If
  1406. End Function
  1407. '*********************************************************
  1412. '*********************************************************
  1413. ' 目的：    unescape
  1414. ' 输入：    
  1415. ' 输入：    要替换的字符
  1416. ' 返回：    
  1417. '*********************************************************
  1418. %>
  1419. <script language="javascript" runat="server">
  1421. function vbsunescape(source){
  1422. return unescape(source);
  1423. }
  1425. </script>