<%
Function BytesToBstr(body,charset2)
   Dim objstream
   Set objstream = Server.CreateObject("adodb.stream")
   objstream.Type = 1
   objstream.Mode =3
   objstream.Open
   objstream.Write body
   objstream.Position = 0
   objstream.Type = 2
   objstream.Charset = charset2
   BytesToBstr = objstream.ReadText 
   objstream.Close
   Set objstream = nothing
End Function

Function Gethtml(URl,charset1)
   Response.Buffer = True
   On Error Resume Next
   Set xmlHttp = Server.CreateObject("Microsoft.XMLHTTP")
   xmlHttp.Open "get",URL,False
   xmlHttp.Send()
   if xmlHttp.readystate<>4 then
		exit function 
   end if 
   Gethtml=BytesToBstr(xmlHttp.ResponseBody,charset1)
   Set xmlHttp=Nothing
End Function
If Err.Number <> 0  Then
      body=Err.Number&"服务器获取文件内容出错，请稍后再试！"
      Response.Clear
End If

Function Getstr(content,b,e)
IF instr(content,b)<>0 or instr(content,e)<>0 then
     w=instr(content,b)
     getstrtemp=mid(content,w+len(b))
	 If instr(getstrtemp,e)-1>0 then getstr=left(getstrtemp,instr(getstrtemp,e)-1)
end if
End Function

Function Gethz(content)
For i = 1 to len(content)
    C=mid(content,i,1)
    IF len(ascw(c))>4 then Gethz=Gethz&c
Next
End Function

Function Code(str)
	Dim strContent
	strContent = Trim(str)
	If Not IsNull(strContent) Then
		strContent = Replace(strContent, "&", "&amp;")
		strContent = Replace(strContent, "<", "&lt;")
		strContent = Replace(strContent, ">", "&gt;")
		strContent = Replace(strContent, Chr(34), "&quot;") '双引号
		strContent = Replace(strContent, Chr(32), "")			'空格
		strContent = Replace(strContent, Chr(10), "")
		strContent = Replace(strContent, Chr(13), "") '回车符
		strContent = Replace(strContent, Chr(39), "&#39;") '单引号
		strContent = Replace(strContent, "<br/><br/><br/>", "")
	End If
	Code = strContent
End Function


Function Rndstr(L,U)
Randomize 
No= Int((U-L+1)*Rnd+L)
Rndstr=No
End Function

Function RegReplace(Str,PatternStr,RepStr)
	Dim NewStr,regEx
	NewStr = Str
	if isnull(NewStr) then
		RegReplace = ""
		exit function
	end if
	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Global = True
	regEx.Pattern=PatternStr
	NewStr = regEx.Replace(NewStr,RepStr)
	RegReplace = NewStr
end function
function UBBCodex(strContent)
	on error resume next

	strContent = HTMLEncode(strContent)
    strContent=replace(strContent,"%20","")
	strContent=replace(strContent,"$","")
	strContent=replace(strContent,"","")
	strContent=replace(strContent,"&nbsp;","")
	strContent=replace(strContent,"&","&amp;")
	dim objRegExp
	Set objRegExp=new RegExp
	objRegExp.IgnoreCase =true
	objRegExp.Global=True

	objRegExp.Pattern="(img=)(http://[A-Za-z0-9\./=\?%\-&_~`@':+!;*()#]+)"
	strContent= objRegExp.Replace(strContent,"<img src=""$2"" alt=""load...""/>")

        objRegExp.Pattern="(\(img)\)(.{5,}?)\(/img\)"
	strContent= objRegExp.Replace(strContent,"<img src=""$2"" alt=""load...""/>")

        objRegExp.Pattern="\(url=(.{5,}?)\)(.+?)\(/url\)"
	strContent= objRegExp.Replace(strContent,"<a href=""$1"" >$2</a>")

	objRegExp.Pattern="(url=)(http://[A-Za-z0-9\./=\?%\-&_~`@':+!;*()#]+)"
	strContent= objRegExp.Replace(strContent,"<a href=""$2"">$2</a>")
        objRegExp.Pattern="(\\)"
	strContent= objRegExp.Replace(strContent,"<br/>")
	        objRegExp.Pattern="-@"
	strContent= objRegExp.Replace(strContent,"<")
		        objRegExp.Pattern="-#"
	strContent= objRegExp.Replace(strContent,">")
	set objRegExp=Nothing
	UBBCodex=strContent
end function

Function Html2clear(Str)		'清楚没有用的HTML代码
	Dim StrContent:StrContent = Trim(Str)
	If Not IsNull(StrContent) Then
		Dim objRegExp, strOutput
		Set objRegExp = New Regexp

		objRegExp.IgnoreCase = True
		objRegExp.Global = True
		objRegExp.Pattern = "<[^>]+>|</[^>]+>"

		'Replace all HTML tag matches with the empty string
		StrContent = objRegExp.Replace(StrContent,"")
	End If
	Html2clear = StrContent
End Function

Function UTF8(Str)
	Dim i,OneStr,AllStr
	For i = 1 To Len(Str)
		OneStr = Mid(Str,i,1)
		AllStr = AllStr & chr(38) & chr(35) & chr(120) & Hex(Ascw(OneStr)) & chr(59)
	Next
	UTF8 = AllStr
End Function
%>