' ============================================
' 判断是否安全字符串,在注册登录等特殊字段中使用
' ============================================
Function IsSafeStr(str)
 Dim s_BadStr, n, i
 s_BadStr = "' 　&<>" & Chr(34) & Chr(9) & Chr(32)
 n = Len(s_BadStr)
 IsSafeStr = True
 For i = 1 To n
  If Instr(str, Mid(s_BadStr, i, 1)) > 0 Then
   IsSafeStr = False
   Exit Function
  End If
 Next
End Function

'===================================== 
'转换内容，防止意外 
'===================================== 
Function Content_Encode(ByVal t0) 
IF IsNull(t0) Or Len(t0)=0 Then 
Content_Encode="" 
Else 
Content_Encode=Replace(t0,"<","&lt;") 
Content_Encode=Replace(Content_Encode,">","&gt;") 
End IF 
End Function 

'===================================== 
'反转换内容 
'===================================== 
Function Content_Decode(ByVal t0) 
IF IsNull(t0) Or Len(t0)=0 Then 
Content_Decode="" 
Else 
Content_Decode=Replace(t0,"&lt;","<") 
Content_Decode=Replace(Content_Decode,"&gt;",">") 
End IF 
End Function 

'===================================== 
'过滤字符 
'===================================== 
Function FilterText(ByVal t0,ByVal t1) 
IF Len(t0)=0 Or IsNull(t0) Or IsArray(t0) Then FilterText="":Exit Function 
t0=Trim(t0) 
Select Case t1 
Case "1" 
t0=Replace(t0,Chr(32),"&nbsp;") 
t0=Replace(t0,Chr(13),"") 
t0=Replace(t0,Chr(10)&Chr(10),"<br>") 
t0=Replace(t0,Chr(10),"<br>") 
Case "2" 
t0=Replace(t0,Chr(8),"")'回格 
t0=Replace(t0,Chr(9),"")'tab(水平制表符) 
t0=Replace(t0,Chr(10),"")'换行 
t0=Replace(t0,Chr(11),"")'tab(垂直制表符) 
t0=Replace(t0,Chr(12),"")'换页 
t0=Replace(t0,Chr(13),"")'回车 chr(13)&chr(10) 回车和换行的组合 
t0=Replace(t0,Chr(22),"") 
t0=Replace(t0,Chr(32),"")'空格 SPACE 
t0=Replace(t0,Chr(33),"")'! 
t0=Replace(t0,Chr(34),"")'" 
t0=Replace(t0,Chr(35),"")'# 
t0=Replace(t0,Chr(36),"")'$ 
t0=Replace(t0,Chr(37),"")'% 
t0=Replace(t0,Chr(38),"")'& 
t0=Replace(t0,Chr(39),"")'' 
t0=Replace(t0,Chr(40),"")'( 
t0=Replace(t0,Chr(41),"")') 
t0=Replace(t0,Chr(42),"")'* 
t0=Replace(t0,Chr(43),"")'+ 
t0=Replace(t0,Chr(44),"")', 
t0=Replace(t0,Chr(45),"")'- 
t0=Replace(t0,Chr(46),"")'. 
t0=Replace(t0,Chr(47),"")'/ 
t0=Replace(t0,Chr(58),"")': 
t0=Replace(t0,Chr(59),"")'; 
t0=Replace(t0,Chr(60),"")'< 
t0=Replace(t0,Chr(61),"")'= 
t0=Replace(t0,Chr(62),"")'> 
t0=Replace(t0,Chr(63),"")'"")'@ 
t0=Replace(t0,Chr(91),"")'\ 
t0=Replace(t0,Chr(92),"")'\ 
t0=Replace(t0,Chr(93),"")'] 
t0=Replace(t0,Chr(94),"")'^ 
t0=Replace(t0,Chr(95),"")'_ 
t0=Replace(t0,Chr(96),"")'` 
t0=Replace(t0,Chr(123),"")'{ 
t0=Replace(t0,Chr(124),"")'| 
t0=Replace(t0,Chr(125),"")'} 
t0=Replace(t0,Chr(126),"")'~ 
Case Else 
t0=Replace(t0, "&", "&amp;") 
t0=Replace(t0, "'", "&#39;") 
t0=Replace(t0, """", "&#34;") 
t0=Replace(t0, "<", "&lt;") 
t0=Replace(t0, ">", "&gt;") 
End Select 
IF Instr(Lcase(t0),"expression")>0 Then 
t0=Replace(t0,"expression","e&#173;xpression", 1, -1, 0) 
End If 
FilterText=t0 
End Function 

'===================================== 
'过滤常见字符及Html 
'===================================== 
Function FilterHtml(ByVal t0) 
IF Len(t0)=0 Or IsNull(t0) Or IsArray(t0) Then FilterHtml="":Exit Function 
IF Len(Sdcms_Badhtml)>0 Then t0=ReplaceText(t0,"<(\/|)("&Sdcms_Badhtml&")", "&lt;$1$2") 
IF Len(Sdcms_BadEvent)>0 Then t0=ReplaceText(t0,"<(.[^>]*)("&Sdcms_BadEvent&")", "&lt;$1$2") 
t0=FilterText(t0,0) 
FilterHtml=t0 
End Function 

Function GotTopic(ByVal t0,ByVal t1) 
IF Len(t0)=0 Or IsNull(t0) Then 
GotTopic="" 
Exit Function 
End IF 
Dim l,t,c, i 
t0=Replace(Replace(Replace(Replace(t0,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<") 
l=Len(t0) 
t=0 
For I=1 To l 
c=Abs(Asc(Mid(t0,i,1))) 
IF c>255 Then t=t+2 Else t=t+1 
IF t>=t1 Then 
gotTopic=Left(t0,I)&"…" 
Exit For 
Else 
GotTopic=t0 
End IF 
Next 
GotTopic=Replace(Replace(Replace(Replace(GotTopic," ","&nbsp;"),chr(34),"&quot;"),">","&gt;"),"<","&lt;") 
End Function 

Function UrlDecode(ByVal t0) 
Dim t1,t2,t3,i,t4,t5,t6 
t1="" 
t2=False 
t3="" 
For I=1 To Len(t0) 
t4=Mid(t0,I,1) 
IF t4="+" Then 
t1=t1&" " 
ElseIF t4="%" Then 
t5=Mid(t0,i+1,2) 
t6=Cint("&H" & t5) 
IF t2 Then 
t2=False 
t1=t1&Chr(Cint("&H"&t3&t5)) 
Else 
IF Abs(t6)<=127 then 
t1=t1&Chr(t6) 
Else 
t2=True 
t3=t5 
End IF 
End IF 
I=I+2 
Else 
t1=t1&t4 
End IF 
Next 
UrlDecode=t1 
End Function 

Function CutStr(byVal t0,byVal t1) 
Dim l,t,c,i 
IF IsNull(t0) Then CutStr="":Exit Function 
l=Len(t0) 
t1=Int(t1) 
t=0 
For I=1 To l 
c=Asc(Mid(t0,I,1)) 
IF c<0 Or c>255 Then t=t+2 Else t=t+1 
IF t>=t1 Then 
CutStr=Left(t0,I)&"..." 
Exit For 
Else 
CutStr=t0 
End IF 
Next 
End Function 

Function CloseHtml(ByVal t0) 
Dim t1,I,t2,t3,Regs,Matches,J,Match 
Set Regs=New RegExp 
Regs.IgnoreCase=True 
Regs.Global=True 
t1=Array("p","div","span","table","ul","font","b","u","i","h1","h2","h3","h4","h5","h6") 
For I=0 To UBound(t1) 
t2=0 
t3=0 
Regs.Pattern="\<"&t1(I)&"( [^\<\>]+|)\>" 
Set Matches=Regs.Execute(t0) 
For Each Match In Matches 
t2=t2+1 
Next 
Regs.Pattern="\</"&t1(I)&"\>" 
Set Matches=Regs.Execute(t0) 
For Each Match In Matches 
t3=t3+1 
Next 
For j=1 To t2-t3 
t0=t0+"</"&t1(I)&">" 
Next 
Next 
CloseHtml=t0 
End Function