format.asp

本程序采用花香内核

<%
function cutstr(str,strlen,more,url)
if len(str)>strlen then
	 str=left(str,strlen) & "......"
end if
if (len(str)>strlen) and more then
  str=str+"&nbsp;&nbsp;&nbsp;[url="+url+"]点这里查看详情[/url]"
end if
cutstr=str
end function

function strLength(str)
       ON ERROR RESUME NEXT
       dim WINNT_CHINESE
       WINNT_CHINESE    = (len("论坛")=2)
       if WINNT_CHINESE then
          dim l,t,c
          dim i
          l=len(str)
          t=l
          for i=1 to l
             c=asc(mid(str,i,1))
             if c<0 then c=c+65536
             if c>255 then
                t=t+1
             end if
          next
          strLength=t
       else 
          strLength=len(str)
       end if
       if err.number<>0 then err.clear
end function
'*************************************************
'函数名：gotTopic
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'       strlen ----截取长度
'返回值：截取后的字符串
'*************************************************
function gotTopic(str,strlen)
	if str="" then
		gotTopic=""
		exit function
	end if
	dim l,t,c, i
	str=replace(replace(replace(replace(str,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<")
	l=len(str)
	t=0
	for i=1 to l
		c=Abs(Asc(Mid(str,i,1)))
		if c>255 then
			t=t+2
		else
			t=t+1
		end if
		if t>=strlen then
			gotTopic=left(str,i) & ".."
			exit for
		else
			gotTopic=str
		end if
	next
	gotTopic=replace(replace(replace(replace(gotTopic," ","&nbsp;"),chr(34),"&quot;"),">","&gt;"),"<","&lt;")
end function
'***********************************************
function AutoUrl(str)
	on error resume next
	Set url=new RegExp
	url.IgnoreCase =True
	url.Global=True
	url.MultiLine = True
	url.Pattern = "^(http://[A-Za-z0-9\./=\?%\-&_~`@:+!]+)"
	str = url.Replace(str,"[url=$1]$1[/url]")
	url.Pattern = "(http://[A-Za-z0-9\./=\?%\-&_~`@:+!]+)$"
	str = url.Replace(str,"[url=$1]$1[/url]")
	url.Pattern = "^(www.[A-Za-z0-9\./=\?%\-&_~`@:+!]+)"
	str = url.Replace(str,"[url=http://$1]$1[/url]")
	url.Pattern = "(www.[A-Za-z0-9\./=\?%\-&_~`@:+!]+)$"
	str = url.Replace(str,"[url=http://$1]$1[/url]")
	set url=Nothing
	AutoUrl=str
end function

Rem 判断数字是否整形
function isInteger(para)
       on error resume next
       dim str
       dim l,i
       if isNUll(para) then 
          isInteger=false
          exit function
       end if
       str=cstr(para)
       if trim(str)="" then
          isInteger=false
          exit function
       end if
       l=len(str)
       for i=1 to l
           if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
              isInteger=false 
              exit function
           end if
       next
       isInteger=true
       if err.number<>0 then err.clear
end function

function DoTrimProperly(str, nNamedFormat, properly, pointed, points)
  dim strRet
  strRet = Server.HTMLEncode(str)
  strRet = replace(strRet, vbcrlf,"<br>")
  strRet = replace(strRet, vbtab,"")
  If (LEN(strRet) > nNamedFormat) Then
    strRet = LEFT(strRet, nNamedFormat)			
    If (properly = 1) Then					
      Dim TempArray								
      TempArray = split(strRet, " ")	
      Dim n
      strRet = ""
      for n = 0 to Ubound(TempArray) - 1
        strRet = strRet & " " & TempArray(n)
      next
    End If
    If (pointed = 1) Then
      strRet = strRet & points
    End If
  End If
  DoTrimProperly = strRet
End Function

Function Hx66_AD(AD_ID)
    set ADRS=server.createobject("adodb.recordset")
    sql="select top 1 AD_ID,AD_Title,AD_Http,AD_width,blank,AD_height,AD_Pic,AD_Note,AD_flash,AD_on from Advertise where AD_on=0 and AD_ID="&AD_ID&""
    ADRS.open sql,conn,1,1
    If ADRS.bof Then
    Response.write"&nbsp;"
    Else
    if ADRS("AD_flash")=true then
    Response.Write("<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0' width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&"><param name='movie' value="&ADRS("Ad_Pic")&"><param name='wmode' value='transparent'><embed src="&ADRS("Ad_Pic")&" quality='high' pluginspage='http://www.macromedia.com/go/getflashplayer' type='application/x-shockwave-flash' width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&"></embed></object>")
    else
    if ADRS("AD_http")="" then
    Response.Write("<div align=center>")
    Response.Write("<img src="&ADRS("Ad_Pic")&" width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&" border=""0""><div>")
    else
    if ADRS("blank")=true then
    Response.Write("<div align=center><a target='_blank' href="&ADRS("Ad_Http")&">")
    Response.Write("<img src="&ADRS("Ad_Pic")&" width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&" border=""0""></a><div>")
    else
    Response.Write("<div align=center><a href="&ADRS("Ad_Http")&">")
    Response.Write("<img src="&ADRS("Ad_Pic")&" width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&" border=""0""></a><div>")
    end if
    end if
    End If
    End If
end Function

Function FormatStr(String)
  on Error resume next
  String = Replace(String, CHR(13), "")
  String = Replace(String, CHR(32), "&nbsp;")
  String = Replace(String, "", "&nbsp;")
  String = Replace(String, "<", "&lt;")
  String = Replace(String, ">", "&gt;")
  String = Replace(String, CHR(10) & CHR(10), "<BR><BR>")
  String = Replace(String, CHR(10), "<BR>")
  FormatStr = String
End Function

Function CODEStr(String)
  on Error resume next
  String = Replace(String, "&", "&#38;")
  String = Replace(String, "R", "&#82;")
  String = Replace(String, "r", "&#114;")
  String = Replace(String, "&amp;", "&#38;&#97;&#109;&#112;&#59;")
  String = Replace(String, "&quot;", "&#38;&#113;&#117;&#111;&#116;&#59;")
  String = Replace(String, "&lt;", "&#38;&#108;&#116;&#59;")
  String = Replace(String, "&gt;", "&#38;&#103;&#116;&#59;")
  String = Replace(String, "&nbsp;", "&#38;&#110;&#98;&#115;&#112;&#59;")
  String = Replace(String, "<", "&lt;")
  String = Replace(String, ">", "&gt;")
  CODEStr = String
End Function

Function Ubb2Html(str, showemot, showimg)
ON ERROR RESUME NEXT