ion
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," "," "),""",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 For
Else
GotTopic=t0
End IF
Next
GotTopic=Replace(Replace(Replace(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 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