Copy codeThe Code is as follows: '==============================================
'Switch content to prevent exceptions
'==============================================
Function Content_Encode (ByVal t0)
IF IsNull (t0) Or Len (t0) = 0 Then
Content_Encode = ""
Else
Content_Encode = Replace (t0, "<", "<")
Content_Encode = Replace (Content_Encode, ">", "> ")
End IF
End Function
'==============================================
'Reverse conversion content
'==============================================
Function Content_Decode (ByVal t0)
IF IsNull (t0) Or Len (t0) = 0 Then
Content_Decode = ""
Else
Content_Decode = Replace (t0, "<", "<")
Content_Decode = Replace (Content_Decode, ">", "> ")
End IF
End Function
'==============================================
'Filter characters
'==============================================
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 ),"")
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), "") 'Return
T0 = Replace (t0, Chr (9), "") 'tab (horizontal tab)
T0 = Replace (t0, Chr (10), "") 'line feed
T0 = Replace (t0, Chr (11), "") 'tab (vertical tab)
T0 = Replace (t0, Chr (12 ), "")'
T0 = Replace (t0, Chr (13), "") 'Carriage return chr (13) & chr (10) combination of carriage return and line feed
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 ,"&","&")
T0 = Replace (t0 ,"'","'")
T0 = Replace (t0 ,"""",""")
T0 = Replace (t0, "<", "<")
T0 = Replace (t0, ">", "> ")
End Select
IF Instr (Lcase (t0), "expression")> 0 Then
T0 = Replace (t0, "expression", "expression", 1,-1, 0)
End If
FilterText = t0
End Function
'==============================================
'Filter common characters and 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 & ")", "<$1 $2 ")
IF Len (Sdcms_BadEvent)> 0 Then t0 = ReplaceText (t0, "<(. [^>] *) ("& Sdcms_BadEvent &") "," <$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 (t0, "", ""), ", chr (34),"> ","> "), "<", "<")
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
Else
GotTopic = t0
End IF
Next
GotTopic = Replace (GotTopic, "", ""), chr (34), "),"> ","> "), "<", "<")
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
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