asp中常用的字符串安全处理函数集合(过滤特殊字符等)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
' ============================================
' 判断是否安全字符串,在注册登录等特殊字段中使用
' ============================================
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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
'===================================== 
'转换内容，防止意外 
'===================================== 
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(64),"")'@ 
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