<%
'///////////////////////////////////////////////////////////////////////////////
'// Z-Blog
'// 作 者: 朱煊(zx.asd)
'// 版权所有: RainbowSoft Studio
'// 技术支持: rainbowsoft@163.com
'// 程序名称:
'// 程序版本:
'// 单元名称: c_function.asp
'// 开始时间: 2004.07.28
'// 最后修改:
'// 备 注: 函数模块
'///////////////////////////////////////////////////////////////////////////////
'*********************************************************
' 目的： 显示错误页面
' 输入： id
' 返回： 无
'*********************************************************
Dim ShowError_Custom
Sub ShowError(id)
If IsEmpty(ShowError_Custom)=False Then
Execute(ShowError_Custom)
Exit Sub
End If
Response.Redirect ZC_BLOG_HOST & "function/c_error.asp?errorid=" & id & "&number=" & Err.Number & "&description=" & Server.URLEncode(Err.Description) & "&source=" & Server.URLEncode(Err.Source)
End Sub
'*********************************************************
'*********************************************************
' 目的： XML-RPC显示错误页面
'*********************************************************
Function RespondError(faultCode,faultString)
Dim strXML
Dim strError
strXML="faultCode$1faultString$2"
strError=strXML
strError=Replace(strError,"$1",TransferHTML(faultCode,"[html-format]"))
strError=Replace(strError,"$2",TransferHTML(faultString,"[html-format]"))
Response.Clear
Response.BinaryWrite ChrB(&HEF) & ChrB(&HBB) & ChrB(&HBF)
Response.Write strError
Response.End
End Function
'*********************************************************
'*********************************************************
' 目的： 检查正则式
' 输入： id
' 返回： 成功为True
'*********************************************************
Function CheckRegExp(source,para)
If para="[username]" Then
para="^[.A-Za-z0-9\u4e00-\u9fa5]+$"
End If
If para="[password]" Then
para="^[a-z0-9]+$"
End If
If para="[email]" Then
para="^([0-9a-zA-Z]([-.\w]*[0-9a-zA-Z])*@([0-9a-zA-Z][-\w]*\.)+[a-zA-Z]*)$"
End If
If para="[homepage]" Then
para="^[a-zA-Z]+://[a-zA-z0-9\-\./]+?/*$"
End If
If para="[nojapan]" Then
para="[\u3040-\u30ff]+"
End If
If para="[guid]" Then
para="^\w{8}\-\w{4}\-\w{4}\-\w{4}\-\w{12}$"
End If
Dim re
Set re = New RegExp
re.Global = True
re.Pattern = para
re.IgnoreCase = False
CheckRegExp = re.Test(source)
End Function
'*********************************************************
'*********************************************************
' 目的： 检查参数
' 返回： 出错则转到ShowError(3)
'*********************************************************
Function CheckParameter(byRef source,strType,default)
On Error Resume Next
If strType="int" Then
'数值
If IsNull(source) Then
source=default
ElseIf IsEmpty(source) Then
source=default
ElseIf IsNumeric(source) Then
source=CLng(source)
ElseIf source="" Then
source=default
Else
Call ShowError(3)
End if
If Err.Number<>0 Then Call ShowError(3)
CheckParameter=True
ElseIf strType="dtm" Then
'日期
If IsNull(source) Then
source=default
ElseIf IsEmpty(source) Then
source=default
ElseIf IsDate(source) Then
source=source
Call FormatDateTime(source,vbLongDate)
Call FormatDateTime(source,vbShortDate)
ElseIf source="" Then
source=default
Else
Call ShowError(3)
End if
If Err.Number<>0 Then Call ShowError(3)
CheckParameter=True
ElseIf strType="sql" Then
'SQL
If IsNull(source) Or Trim(source)="" Or IsEmpty(source) Then
source=default
Else
source=CStr(Replace(source,Chr(39),Chr(39)&Chr(39)))
End If
ElseIf strType="bool" Then
'Boolean
source=CBool(source)
If Err.Number<>0 Then
Err.Clear
If IsEmpty(source)=True Then
source=True
Else
source=False
End If
End If
Else
Call ShowError(0)
End If
End Function
'*********************************************************
'*********************************************************
' 目的： 检查引用
' 返回： 无
'*********************************************************
Sub CheckReference(strDestination)
Exit Sub
Dim strReferer
strReferer=CStr(Request.ServerVariables("HTTP_REFERER"))
If Instr(strReferer,ZC_BLOG_HOST)=0 Then
ShowError(5)
End If
End Sub
'*********************************************************
'*********************************************************
' 目的： 搜索字符串
' 返回：
' 备注: 不区分大小写
'*********************************************************
Function Search(strText,strQuestion)
Dim s
Dim i
Dim j
s=strText
i=Instr(1,s,strQuestion,vbTextCompare)
If i>0 Then
s=Left(s,i+Len(strQuestion)+100)
s=Right(s,Len(strQuestion)+200)
Else
s=""
End If
If s<>"" Then
i=1
Do While InStr(i,s,strQuestion,vbTextCompare)>0
j=InStr(i,s,strQuestion,vbTextCompare)
If Len(s)-j-Len(strQuestion)<0 Then
s=Left(s,j-1) & "" & strQuestion & ""
Exit Do
Else
s=Left(s,j-1) & "" & strQuestion & "" & Right(s,Len(s)-j-Len(strQuestion)+1)
End If
i=j+Len("" & strQuestion & "")-1
If i>=Len(s) Then Exit Do
Loop
End If
If s="" Then
Search=strText
Else
Search=s
End If
End Function
'*********************************************************
'*********************************************************
' 目的： 检查引用
' 输入： SQL值（引用）
' 返回：
'*********************************************************
Function FilterSQL(strSQL)
FilterSQL=CStr(Replace(strSQL,chr(39),chr(39)&chr(39)))
End Function
'*********************************************************
'*********************************************************
' 目的： 检查引用
' 输入：
' 输入： 要替换的字符代号
' 返回：
'*********************************************************
Function TransferHTML(source,para)
Dim objRegExp
'先换"&"
If Instr(para,"[&]")>0 Then source=Replace(source,"&","&")
If Instr(para,"[<]")>0 Then source=Replace(source,"<","<")
If Instr(para,"[>]")>0 Then source=Replace(source,">",">")
If Instr(para,"[""]")>0 Then source=Replace(source,"""",""")
If Instr(para,"[space]")>0 Then source=Replace(source," "," ")
If Instr(para,"[enter]")>0 Then
source=Replace(source,vbCrLf,"
")
source=Replace(source,vbLf,"
")
End If
If Instr(para,"[vbCrlf]")>0 And ZC_AUTO_NEWLINE Then
Set objRegExp=New RegExp
objRegExp.IgnoreCase =True
objRegExp.Global=True
objRegExp.Pattern="(()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|())(\x20*(\r\n|\n))"
source= objRegExp.Replace(source,"$1")
objRegExp.Pattern="(\r\n|\n)"
source= objRegExp.Replace(source,"
")
source=Replace(source,"","")
source=Replace(source,"","")
source=Replace(source,"","")
source=Replace(source,"","")
End If
If Instr(para,"[vbTab]")>0 Then source=Replace(source,vbTab," ")
If Instr(para,"[upload]")>0 Then
source=Replace(source,"src=""upload/","src="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/")
source=Replace(source,"href=""upload/","href="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/")
source=Replace(source,"value=""upload/","value="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/")
source=Replace(source,"href=""http://upload/","href="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/")
End If
If Instr(para,"[no-asp]")>0 Then
source=Replace(source,"<"&"%","<"&"%")
source=Replace(source,"%"&">","%"&">")
End If
If ZC_COMMENT_NOFOLLOW_ENABLE And Instr(para,"[nofollow]")>0 Then
source=Replace(source,"0 Then
Set objRegExp=New RegExp
objRegExp.IgnoreCase =True
objRegExp.Global=True
objRegExp.Pattern="<[^>]*>"
source= objRegExp.Replace(source,"")
End If
If Instr(para,"[filename]")>0 Then
source=Replace(source,"/","")
source=Replace(source,"\","")
source=Replace(source,":","")
source=Replace(source,"?","")
source=Replace(source,"*","")
source=Replace(source,"""","")
source=Replace(source,"<","")
source=Replace(source,">","")
source=Replace(source,"|","")
source=Replace(source," ","")
End If
If Instr(para,"[normalname]")>0 Then
source=Replace(source,"$","")
source=Replace(source,"(","")
source=Replace(source,")","")
source=Replace(source,"*","")
source=Replace(source,"+","")
source=Replace(source,",","")
source=Replace(source,"[","")
source=Replace(source,"]","")
source=Replace(source,"{","")
source=Replace(source,"}","")
source=Replace(source,"?","")
source=Replace(source,"\","")
source=Replace(source,"^","")
source=Replace(source,"|","")
source=Replace(source,":","")
source=Replace(source,"""","")
End If
If Instr(para,"[textarea]")>0 Then
'Set objRegExp=New RegExp
'objRegExp.IgnoreCase =True
'objRegExp.Global=True
'objRegExp.Pattern="(&)([#a-z0-9]{2,10})(;)"
'source= objRegExp.Replace(source,"&$2$3")
source=Replace(source,"&","&")
source=Replace(source,"%","%")
source=Replace(source,"<","<")
source=Replace(source,">",">")
End If
If ZC_JAPAN_TO_HTML And Instr(para,"[japan-html]")>0 Then
source=Replace(source,"ガ","ガ")
source=Replace(source,"ギ","ギ")
source=Replace(source,"ア","ア")
source=Replace(source,"ゲ","ゲ")
source=Replace(source,"ゴ","ゴ")
source=Replace(source,"ザ","ザ")
source=Replace(source,"ジ","ジ")
source=Replace(source,"ズ","ズ")
source=Replace(source,"ゼ","ゼ")
source=Replace(source,"ゾ","ゾ")
source=Replace(source,"ダ","ダ")
source=Replace(source,"ヂ","ヂ")
source=Replace(source,"ヅ","ヅ")
source=Replace(source,"デ","デ")
source=Replace(source,"ド","ド")
source=Replace(source,"バ","バ")
source=Replace(source,"パ","パ")
source=Replace(source,"ビ","ビ")
source=Replace(source,"ピ","ピ")
source=Replace(source,"ブ","ブ")
source=Replace(source,"ブ","ブ")
source=Replace(source,"プ","プ")
source=Replace(source,"ベ","ベ")
source=Replace(source,"ペ","ペ")
source=Replace(source,"ボ","ボ")
source=Replace(source,"ポ","ポ")
source=Replace(source,"ヴ","ヴ")
End If
If ZC_JAPAN_TO_HTML And Instr(para,"[html-japan]")>0 Then
source=Replace(source,"ガ","ガ")
source=Replace(source,"ギ","ギ")
source=Replace(source,"ア","ア")
source=Replace(source,"ゲ","ゲ")
source=Replace(source,"ゴ","ゴ")
source=Replace(source,"ザ","ザ")
source=Replace(source,"ジ","ジ")
source=Replace(source,"ズ","ズ")
source=Replace(source,"ゼ","ゼ")
source=Replace(source,"ゾ","ゾ")
source=Replace(source,"ダ","ダ")
source=Replace(source,"ヂ","ヂ")
source=Replace(source,"ヅ","ヅ")
source=Replace(source,"デ","デ")
source=Replace(source,"ド","ド")
source=Replace(source,"バ","バ")
source=Replace(source,"パ","パ")
source=Replace(source,"ビ","ビ")
source=Replace(source,"ピ","ピ")
source=Replace(source,"ブ","ブ")
source=Replace(source,"ブ","ブ")
source=Replace(source,"プ","プ")
source=Replace(source,"ベ","ベ")
source=Replace(source,"ペ","ペ")
source=Replace(source,"ボ","ボ")
source=Replace(source,"ポ","ポ")
source=Replace(source,"ヴ","ヴ")
End If
If Instr(para,"[html-format]")>0 Then
source=Replace(source,"&","&")
source=Replace(source,"<","<")
source=Replace(source,">",">")
source=Replace(source,"""",""")
End If
If Instr(para,"[wapnohtml]")>0 Then
source=Replace(source,"
",vbCrLf)
source=Replace(source,"
",vbCrLf)
Set objRegExp=New RegExp
objRegExp.IgnoreCase =True
objRegExp.Global=True
objRegExp.Pattern="(<[^>]*)|([^<]*>)"
source= objRegExp.Replace(source,"")
objRegExp.Pattern="(\r\n|\n)"
source= objRegExp.Replace(source,"
")
End If
If Instr(para,"[nbsp-br]")>0 Then
Set objRegExp=New RegExp
objRegExp.IgnoreCase =True
objRegExp.Global=True
objRegExp.Pattern="<$|<b$|<br$|<br/$"
source= objRegExp.Replace(source,"")
objRegExp.Pattern="^br/>|^r/>|^/>|^>"
source= objRegExp.Replace(source,"")
objRegExp.Pattern="<br/>"
source= objRegExp.Replace(source,"
")
objRegExp.Pattern=" "
source= objRegExp.Replace(source," ")
End If
TransferHTML=source
End Function
'*********************************************************
'*********************************************************
' 目的： 301 Moved
' 输入：
' 返回：
'*********************************************************
Sub RedirectBy301(strURL)
Response.Clear
Response.Status="301 Moved Permanently"
Response.AddHeader "Location",strURL
Response.End
End Sub
'*********************************************************
'*********************************************************
' 目的： Random Number Create
' 输入：
' 返回：
'*********************************************************
Sub CreateVerifyNumber()
Dim i,j,s,t
Randomize
Dim aryVerifyNumber(10000)
For j=0 To 10000
s=""
For i = 0 To 4
t = Int(Rnd * 10)
s= s & Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",t + 1, 1)
Next
aryVerifyNumber(j)=s
Next
Application.Lock
Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")=aryVerifyNumber
Application.UnLock
End Sub
'*********************************************************
'*********************************************************
' 目的： Random Number Get
' 输入：
' 返回：
'*********************************************************
Function GetVerifyNumber()
Randomize
Dim i,j,s,t
Dim aryVerifyNumber
Application.Lock
aryVerifyNumber=Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")
Application.UnLock
If IsEmpty(aryVerifyNumber) Then
Call CreateVerifyNumber()
Application.Lock
aryVerifyNumber=Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")
Application.UnLock
End If
For i=0 To 10000
If (aryVerifyNumber(i)<>"") And (Len(aryVerifyNumber(i))=5) Then
GetVerifyNumber=aryVerifyNumber(i)
Exit For
End If
Next
aryVerifyNumber(i)=aryVerifyNumber(i)&"-"
If i=5000 Then
For j=5001 To 10000
s=""
For i = 0 To 4
t = Int(Rnd * 10)
s= s & Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",t + 1, 1)
Next
aryVerifyNumber(j)=s
Next
End If
If i=10000 Then
For j=0 To 5000
s=""
For i = 0 To 4
t = Int(Rnd * 10)
s= s & Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",t + 1, 1)
Next
aryVerifyNumber(j)=s
Next
End If
Application.Lock
Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")=aryVerifyNumber
Application.UnLock
End Function
'*********************************************************
'*********************************************************
' 目的： Random Number Check
' 输入：
' 返回：
'*********************************************************
Function CheckVerifyNumber(strNumber)
Dim i,j,s,t
Dim aryVerifyNumber
Application.Lock
aryVerifyNumber=Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")
Application.UnLock
If IsEmpty(aryVerifyNumber) Then Exit Function
For j=0 To 10000
If aryVerifyNumber(j)=strNumber & "-" Then
Randomize
s=""
For i = 0 To 4
t = Int(Rnd * 10)
s= s & Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",t + 1, 1)
Next
aryVerifyNumber(j)=s
Application.Lock
Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")=aryVerifyNumber
Application.UnLock
CheckVerifyNumber=True
Exit Function
End If
Next
End Function
'*********************************************************
'*********************************************************
' 目的： UBB
' 输入：
' 输入：
' 返回：
'*********************************************************
Function UBBCode(strContent,strType)
Dim objRegExp
Set objRegExp=new RegExp
objRegExp.IgnoreCase =True
objRegExp.Global=True
If ZC_UBB_LINK_ENABLE And Instr(strType,"[link]")>0 Then
objRegExp.Pattern="(\[URL\])(([a-zA-Z0-9]+?):\/\/\S+?)(\[\/URL\])"
strContent= objRegExp.Replace(strContent,"$2")
objRegExp.Pattern="(\[URL\])(.+?)(\[\/URL\])"
strContent= objRegExp.Replace(strContent,"$2")
objRegExp.Pattern="(\[URL=)(([a-zA-Z0-9]+?):\/\/\S+?)(\])(.+?)(\[\/URL\])"
strContent= objRegExp.Replace(strContent,"$5")
objRegExp.Pattern="(\[URL=)(\S+?)(\])(\S+?)(\[\/URL\])"
strContent= objRegExp.Replace(strContent,"$4")
objRegExp.Pattern="(\[EMAIL\])(\S+\@\S+?)(\[\/EMAIL\])"
strContent= objRegExp.Replace(strContent,"$2")
objRegExp.Pattern="(\[EMAIL=)(\S+\@\S+?)(\])(.+?)(\[\/EMAIL\])"
strContent= objRegExp.Replace(strContent,"$4")
End If
If ZC_UBB_FONT_ENABLE And Instr(strType,"[font]")>0 Then
objRegExp.Pattern="(\[I\])([\u0000-\uffff]+?)(\[\/I\])"
strContent=objRegExp.Replace(strContent,"$2")
objRegExp.Pattern="(\[B\])([\u0000-\uffff]+?)(\[\/B\])"
strContent=objRegExp.Replace(strContent,"$2")
objRegExp.Pattern="(\[U\])([\u0000-\uffff]+?)(\[\/U\])"
strContent=objRegExp.Replace(strContent,"$2")
objRegExp.Pattern="(\[S\])([\u0000-\uffff]+?)(\[\/S\])"
strContent=objRegExp.Replace(strContent,"$2")
objRegExp.Pattern="(\[QUOTE\])([\u0000-\uffff]+?)(\[\/QUOTE\])"
strContent=objRegExp.Replace(strContent,"$2"&vbCrlf&"
")
objRegExp.Pattern="(\[QUOTE=)(.+?)(\])([\u0000-\uffff]+?)(\[\/QUOTE\])"
strContent= objRegExp.Replace(strContent,""&ZC_MSG153&" $2
$4"&vbCrlf&"
")
strContent =Replace(strContent,Match,strCode)
objRegExp.Global=False
objRegExp.Pattern="(\[CODE_LITE\]()?)(.+?)(\[\/CODE_LITE\])"
strContent=objRegExp.Replace(strContent,"$3
")
objRegExp.Global=True
Next
Set Matches = Nothing
'[CODE]
objRegExp.Pattern="(\[CODE\])(.+?)(\[\/CODE\])"
Set Matches = objRegExp.Execute(strContent)
For Each Match in Matches
strCode=Match
strCode = TransferHTML(strCode,"[<][>][space][vbTab]")
strCode = Replace(strCode,vbCr,Chr(8)&Chr(11)&Chr(9)&Chr(12))
strContent =Replace(strContent,Match,strCode)
objRegExp.Global=False
objRegExp.Pattern="(\[CODE\])(.+?)(\[\/CODE\])"
strContent=objRegExp.Replace(strContent,"")
objRegExp.Global=True
Next
Set Matches = Nothing
strContent =Replace(strContent,vbCr,vbCrLf)
strContent =Replace(strContent,Chr(8)&Chr(11)&Chr(9)&Chr(12),vbCr)
End If
If ZC_UBB_FACE_ENABLE And Instr(strType,"[face]")>0 Then
objRegExp.Pattern="(\[F\])(.+?)(\[\/F\])"
strContent= objRegExp.Replace(strContent,"![]()
")
End If
If ZC_UBB_IMAGE_ENABLE And Instr(strType,"[image]")>0 Then
'[img]
objRegExp.Pattern="(\[IMG=)([0-9]*),([0-9]*),([^\n\[]*)(\])(.+?)(\[\/IMG\])"
strContent= objRegExp.Replace(strContent,"![]()
")
objRegExp.Pattern="(\[IMG=)([0-9]*),([^\n\[]*)(\])(.+?)(\[\/IMG\])"
strContent= objRegExp.Replace(strContent,"![]()
")
objRegExp.Pattern="(\[IMG=)([0-9]*)(\])(.+?)(\[\/IMG\])"
strContent= objRegExp.Replace(strContent,"![]()
")
objRegExp.Pattern="(\[IMG\])(.+?)(\[\/IMG\])"
strContent= objRegExp.Replace(strContent,"![]()
")
objRegExp.Pattern="(\[IMG_LEFT=)([0-9]*),([0-9]*),([^\n\[]*)(\])(.+?)(\[\/IMG_LEFT\])"
strContent= objRegExp.Replace(strContent,"![]()
")
objRegExp.Pattern="(\[IMG_LEFT=)([0-9]*),([^\n\[]*)(\])(.+?)(\[\/IMG_LEFT\])"
strContent= objRegExp.Replace(strContent,"![]()
")
objRegExp.Pattern="(\[IMG_LEFT=)([0-9]*)(\])(.+?)(\[\/IMG_LEFT\])"
strContent= objRegExp.Replace(strContent,"![]()
")
objRegExp.Pattern="(\[IMG_LEFT\])(.+?)(\[\/IMG_LEFT\])"
strContent= objRegExp.Replace(strContent,"![]()
")
objRegExp.Pattern="(\[IMG_RIGHT=)([0-9]*),([0-9]*),(.*)(\])(.+?)(\[\/IMG_RIGHT\])"
strContent= objRegExp.Replace(strContent,"![]()
")
objRegExp.Pattern="(\[IMG_RIGHT=)([0-9]*),(.*)(\])(.+?)(\[\/IMG_RIGHT\])"
strContent= objRegExp.Replace(strContent,"![]()
")
objRegExp.Pattern="(\[IMG_RIGHT=)([0-9]*)(\])(.+?)(\[\/IMG_RIGHT\])"
strContent= objRegExp.Replace(strContent,"![]()
")
objRegExp.Pattern="(\[IMG_RIGHT\])(.+?)(\[\/IMG_RIGHT\])"
strContent= objRegExp.Replace(strContent,"![]()
")
End If
If ZC_UBB_FLASH_ENABLE And Instr(strType,"[flash]")>0 Then
'[flash]
objRegExp.Pattern="(\[FLASH=)([0-9]*),([0-9]*),([a-z]*)(\])(.+?)(\[\/FLASH\])"
strContent= objRegExp.Replace(strContent,"")
End If
If ZC_UBB_TYPESET_ENABLE And Instr(strType,"[typeset]")>0 Then
objRegExp.Pattern="(\[ALIGN-CENTER\])([\u0000-\uffff]+?)(\[\/ALIGN-CENTER\])"
strContent=objRegExp.Replace(strContent,"$2
")
objRegExp.Pattern="(\[ALIGN-LELT\])([\u0000-\uffff]+?)(\[\/ALIGN-LELT\])"
strContent=objRegExp.Replace(strContent,"$2
")
objRegExp.Pattern="(\[ALIGN-RIGHT\])([\u0000-\uffff]+?)(\[\/ALIGN-RIGHT\])"
strContent=objRegExp.Replace(strContent,"$2
")
objRegExp.Pattern="(\[HR\])([\u0000-\uffff]?)(\[\/HR\])"
strContent=objRegExp.Replace(strContent,"
")
objRegExp.Pattern="(\[FONT-FACE=)([a-z\x20]*)(\])([\u0000-\uffff]+?)(\[\/FONT-FACE\])"
strContent=objRegExp.Replace(strContent,"$4")
objRegExp.Pattern="(\[FACE=)([a-z\x20]*)(\])([\u0000-\uffff]+?)(\[\/FACE\])"
strContent=objRegExp.Replace(strContent,"$4")
objRegExp.Pattern="(\[FONT-SIZE=)([1-7]*)(\])([\u0000-\uffff]+?)(\[\/FONT-SIZE\])"
strContent=objRegExp.Replace(strContent,"$4")
objRegExp.Pattern="(\[SIZE=)([1-7]*)(\])([\u0000-\uffff]+?)(\[\/SIZE\])"
strContent=objRegExp.Replace(strContent,"$4")
objRegExp.Pattern="(\[FONT-COLOR=)([#0-9a-z]*)(\])([\u0000-\uffff]+?)(\[\/FONT-COLOR\])"
strContent=objRegExp.Replace(strContent,"$4")
objRegExp.Pattern="(\[COLOR=)([#0-9a-z]*)(\])([\u0000-\uffff]+?)(\[\/COLOR\])"
strContent=objRegExp.Replace(strContent,"$4")
End If
If ZC_UBB_MEDIA_ENABLE And Instr(strType,"[media]")>0 Then
'[WMA]
objRegExp.Pattern="(\[WMA=)([a-z]*)(\])(.+?)(\[\/WMA\])"
strContent= objRegExp.Replace(strContent,"")
objRegExp.Pattern="(\[WMA\])(.+?)(\[\/WMA\])"
strContent= objRegExp.Replace(strContent,"")
'[WMV]
objRegExp.Pattern="(\[WMV=)([0-9]*),([0-9]*),([a-z]*)(\])(.+?)(\[\/WMV\])"
strContent= objRegExp.Replace(strContent,"")
objRegExp.Pattern="(\[WMV\])(.+?)(\[\/WMV\])"
strContent= objRegExp.Replace(strContent,"")
'[RMV]
objRegExp.Pattern="(\[RM=)([0-9]*),([0-9]*),([a-z]*)(\])(.+?)(\[\/RM\])"
strContent= objRegExp.Replace(strContent,"")
objRegExp.Pattern="(\[RM\])(.+?)(\[\/RM\])"
strContent= objRegExp.Replace(strContent,"")
'[RA]
objRegExp.Pattern="(\[RA=)([a-z]*)(\])(.+?)(\[\/RA\])"
strContent= objRegExp.Replace(strContent,"")
objRegExp.Pattern="(\[RA\])(.+?)(\[\/RA\])"
strContent= objRegExp.Replace(strContent,"")
'[QT]
objRegExp.Pattern="(\[QT=)([0-9]*),([0-9]*),([a-z]*)(\])(.+?)(\[\/QT\])"
strContent= objRegExp.Replace(strContent,"")
objRegExp.Pattern="(\[QT\])(.+?)(\[\/QT\])"
strContent= objRegExp.Replace(strContent,"")
'[MEDIA]
objRegExp.Pattern="(\[MEDIA=)([a-z]*),([0-9]*),([0-9]*)(\])(.+?)(\[\/MEDIA\])"
strContent= objRegExp.Replace(strContent,"")
objRegExp.Pattern="(\[MEDIA=)([0-9]*),([0-9]*)(\])(.+?)(\[\/MEDIA\])"
strContent= objRegExp.Replace(strContent,"")
objRegExp.Pattern="(\[MEDIA\])(.+?)(\[\/MEDIA\])"
strContent= objRegExp.Replace(strContent,"")
End If
If ZC_UBB_AUTOLINK_ENABLE And Instr(strType,"[autolink]")>0 Then
objRegExp.Pattern="(^|\r\n|\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}[^<>\f\n\r\t\v]+?)(\r\n|\n|$)"
strContent=objRegExp.Replace(strContent,vbCrlf & "$2" & vbCrlf)
objRegExp.Pattern="(^|\r\n|\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}[^<>\f\n\r\t\v]+?)(\r\n|\n|$)"
strContent=objRegExp.Replace(strContent,vbCrlf & "$2" & vbCrlf)
End If
If ZC_UBB_AUTOKEY_ENABLE And Instr(strType,"[key]")>0 Then
Dim i,j
If IsArray(KeyWords) Then
For i=Lbound(KeyWords,2) To Ubound(KeyWords,2)
objRegExp.Pattern="((<.*)("&KeyWords(1,i)&")(.*>))|(())"
Set Matches = objRegExp.Execute(strContent)
For Each Match in Matches
strContent=Replace(strContent,Match,vbVerticalTab & vbTab & vbVerticalTab)
Next
strContent=Replace(strContent,KeyWords(1,i),""& KeyWords(1,i) &"")
For Each Match in Matches
strContent=Replace(strContent,vbVerticalTab & vbTab & vbVerticalTab,Match,1,1)
Next
Set Matches = Nothing
Next
End If
End If
If ZC_UBB_LINK_ENABLE And Instr(strType,"[link-antispam]")>0 Then
Dim Match2, Matches2 ,strCode2
objRegExp.Pattern="(href="".+?"")"
Set Matches2 = objRegExp.Execute(strContent)
For Each Match2 in Matches2
strCode2=Match2
strCode2=Left(strCode2,Len(strCode2)-1)
strCode2=Right(strCode2,Len(strCode2)-6)
strCode2=URLEncodeForAntiSpam(strCode2)
strContent =Replace(strContent,Match2,"href=""" & strCode2 & """")
Next
Set Matches2 = Nothing
End If
Set objRegExp=Nothing
UBBCode=strContent
End Function
'*********************************************************
'*********************************************************
' 目的： Save Text to File
' 输入：
' 输入：
' 返回：
'*********************************************************
Function SaveToFile(strFullName,strContent,strCharset,bolRemoveBOM)
On Error Resume Next
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Type = adTypeText
.Mode = adModeReadWrite
.Open
.Charset = strCharset
.Position = objStream.Size
.WriteText = strContent
.SaveToFile strFullName,adSaveCreateOverWrite
.Close
End With
Set objStream = Nothing
If bolRemoveBOM Then
If strContent<>"" And ZC_STATIC_TYPE="shtml" Then
Call RemoveBOM(strFullName)
End If
End If
Err.Clear
End Function
'*********************************************************
'*********************************************************
' 目的： Load Text form File
' 输入：
' 输入：
' 返回：
'*********************************************************
Function LoadFromFile(strFullName,strCharset)
On Error Resume Next
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Type = adTypeText
.Mode = adModeReadWrite
.Open
.Charset = strCharset
.Position = objStream.Size
.LoadFromFile strFullName
LoadFromFile=.ReadText
.Close
End With
Set objStream = Nothing
Err.Clear
End Function
'*********************************************************
'*********************************************************
' 目的： Remove BOM from UTF-8
'*********************************************************
Function RemoveBOM(strFullName)
On Error Resume Next
Dim objStream
Dim strContent
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Type = adTypeBinary
.Mode = adModeReadWrite
.Open
.Position = objStream.Size
.LoadFromFile strFullName
.Position = 3
strContent=.Read
.Close
End With
Set objStream = NoThing
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Type = adTypeBinary
.Mode = adModeReadWrite
.Open
.Position = objStream.Size
.Write = strContent
.SaveToFile strFullName,adSaveCreateOverWrite
.Close
End With
Set objStream = Nothing
Err.Clear
End Function
'*********************************************************
'*********************************************************
' 目的： Save Value For Setting
'*********************************************************
Function SaveValueForSetting(ByRef strContent,bolConst,strTypeVar,strItem,strValue)
Dim i,j,s,t
Dim strConst
Dim objRegExp
If bolConst=True Then strConst="Const"
Set objRegExp=New RegExp
objRegExp.IgnoreCase =True
objRegExp.Global=True
strValue=TransferHTML(strValue,"[no-asp]")
If strTypeVar="String" Then
strValue=Replace(strValue,"""","""""")
strValue=""""& strValue &""""
objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))(.+?)(\r\n|\n|$)"
If objRegExp.Test(strContent)=True Then
strContent=objRegExp.Replace(strContent,"$1$2"& strValue &"$8")
SaveValueForSetting=True
Exit Function
End If
End If
If strTypeVar="Boolean" Then
strValue=Trim(strValue)
If LCase(strValue)="true" Then
strValue="True"
Else
strValue="False"
End If
If objRegExp.Test(strContent)=True Then
objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([a-z]+)( *)(\r\n|\n|$)"
strContent=objRegExp.Replace(strContent,"$1$2"& strValue &"$9")
SaveValueForSetting=True
Exit Function
End If
End If
If strTypeVar="Numeric" Then
strValue=Trim(strValue)
If IsNumeric(strValue)=False Then
strValue=0
End If
If objRegExp.Test(strContent)=True Then
objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([0-9.]+)( *)(\r\n|\n|$)"
strContent=objRegExp.Replace(strContent,"$1$2"& strValue &"$9")
SaveValueForSetting=True
Exit Function
End If
End If
SaveValueForSetting=False
End Function
'*********************************************************
'*********************************************************
' 目的： Load Value For Setting
'*********************************************************
Function LoadValueForSetting(strContent,bolConst,strTypeVar,strItem,ByRef strValue)
Dim i,j,s,t
Dim strConst
Dim objRegExp
Dim Matches,Match
If bolConst=True Then strConst="Const"
Set objRegExp=New RegExp
objRegExp.IgnoreCase =True
objRegExp.Global=True
If strTypeVar="String" Then
objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))(.+?)(\r\n|\n|$)"
Set Matches = objRegExp.Execute(strContent)
If Matches.Count=1 Then
t=Matches(0).Value
t=Replace(t,VbCrlf,"")
t=Replace(t,Vblf,"")
objRegExp.Pattern="( *)""(.*)""( *)($)"
Set Matches = objRegExp.Execute(t)
If Matches.Count>0 Then
s=Trim(Matches(0).Value)
s=Mid(s,2,Len(s)-2)
s=Replace(s,"""""","""")
strValue=s
LoadValueForSetting=True
Exit Function
End If
End If
End If
If strTypeVar="Boolean" Then
objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([a-z]+)( *)(\r\n|\n|$)"
Set Matches = objRegExp.Execute(strContent)
If Matches.Count=1 Then
t=Matches(0).Value
t=Replace(t,VbCrlf,"")
t=Replace(t,Vblf,"")
objRegExp.Pattern="( *)((True)|(False))( *)($)"
Set Matches = objRegExp.Execute(t)
If Matches.Count>0 Then
s=Trim(Matches(0).Value)
s=LCase(Matches(0).Value)
If InStr(s,"true")>0 Then
strValue=True
ElseIf InStr(s,"false")>0 Then
strValue=False
End If
LoadValueForSetting=True
Exit Function
End If
End If
End If
If strTypeVar="Numeric" Then
objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([0-9.]+)( *)(\r\n|\n|$)"
Set Matches = objRegExp.Execute(strContent)
If Matches.Count=1 Then
t=Matches(0).Value
t=Replace(t,VbCrlf,"")
t=Replace(t,Vblf,"")
objRegExp.Pattern="( *)([0-9.]+)( *)($)"
Set Matches = objRegExp.Execute(t)
If Matches.Count>0 Then
s=Trim(Matches(0).Value)
If IsNumeric(s)=True Then
strValue=s
LoadValueForSetting=True
Exit Function
End If
End If
End If
End If
LoadValueForSetting=False
End Function
'*********************************************************
'*********************************************************
' 目的：
'*********************************************************
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
'*********************************************************
'*********************************************************
' 目的：
'*********************************************************
Function URLEncodeForAntiSpam(strUrl)
Dim i,s
For i =1 To Len(strUrl)
s=s & Mid(strUrl,i,1) & CStr(Int((10 * Rnd)))
Next
URLEncodeForAntiSpam=ZC_BLOG_HOST & "function/c_urlredirect.asp?url=" & Server.URLEncode(s)
End Function
'*********************************************************
'*********************************************************
' 目的：
'*********************************************************
Function URLDecodeForAntiSpam(strUrl)
Dim i,s
For i =1 To Len(strUrl) Step 2
s=s & Mid(strUrl,i,1)
Next
URLDecodeForAntiSpam=s
End Function
'*********************************************************
'*********************************************************
' 目的： unescape
' 输入：
' 输入： 要替换的字符
' 返回：
'*********************************************************
%>