数模论坛

 找回密码
 注-册-帐-号
搜索
热搜: 活动 交友 discuz
查看: 2814|回复: 2

怎么都是MATLAB,我来发表一段ASP

[复制链接]
发表于 2003-9-23 09:34:42 | 显示全部楼层 |阅读模式
<%
'解释<br>时加换行
function htmlencode(str)
    dim htmlresult
    dim l
    if isNULL(str) then
       htmlencode=""
       exit function
    end if
    l=len(str)
    htmlresult=""
        dim i
        for i = 1 to l
            select case mid(str,i,1)
                   case "<"
                        htmlresult=htmlresult+"&lt;"
                   case ">"
                        htmlresult=htmlresult+"&gt;"
              case chr(13)
                        htmlresult=htmlresult+"<br>"
                   case chr(34)
                        htmlresult=htmlresult+"&quot;"
                   case "&"
                        htmlresult=htmlresult+"&amp;"
              case chr(32)                   
                        'htmlresult=htmlresult+"&nbsp;"
                        if i+1<=l and i-1>0 then
                           if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9)  then                              
                              htmlresult=htmlresult+"&nbsp;"
                           else
                              htmlresult=htmlresult+" "
                           end if
                        else
                           htmlresult=htmlresult+"&nbsp;"                            
                        end if
                   case chr(9)
                        htmlresult=htmlresult+"    "
                   case else
                        htmlresult=htmlresult+mid(str,i,1)
         end select
       next
       htmlencode=htmlresult
   end function


function sustainhtml(str)
    dim htmlresult
    dim l
    if isNULL(str) then
       sustainhtml=""
       exit function
    end if
    l=len(str)
    htmlresult=""
        dim i
        for i = 1 to l
            select case mid(str,i,1)
                   case chr(13)
                        htmlresult=htmlresult+"<br>"
                   case chr(34)
                        htmlresult=htmlresult+"&quot;"
                   case chr(32)                   
                        'htmlresult=htmlresult+"&nbsp;"
                        if i+1<=l and i-1>0 then
                           if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9)  then                              
                              htmlresult=htmlresult+"&nbsp;"
                           else
                              htmlresult=htmlresult+" "
                           end if
                        else
                           htmlresult=htmlresult+"&nbsp;"                            
                        end if
                   case "&"
                        htmlresult=htmlresult+"&amp;"
                   case chr(9)
                        htmlresult=htmlresult+"    "
                   case else
                        htmlresult=htmlresult+mid(str,i,1)
         end select
       next
       sustainhtml=htmlresult
   end function

' 检查sql字符串中是否有单引号,有则进行转化
   function CheckStr(str)
       dim tstr,l,i,ch
           l=len(str)
           for i=1 to l
               ch=mid(str,i,1)
               if ch="'" then
                      tstr=tstr+"'"
                   end if
                   tstr=tstr+ch
           next
           CheckStr=tstr
   end function

'email有效性检查
function IsValidEmail(email)

dim names, name, i, c

'Check for valid syntax in an email address.

IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
   IsValidEmail = false
   exit function
end if
for each name in names
   if Len(name) <= 0 then
     IsValidEmail = false
     exit function
   end if
   for i = 1 to Len(name)
     c = Lcase(Mid(name, i, 1))
     if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
       IsValidEmail = false
       exit function
     end if
   next
   if Left(name, 1) = "." or Right(name, 1) = "." then
      IsValidEmail = false
      exit function
   end if
next
if InStr(names(1), ".") <= 0 then
   IsValidEmail = false
   exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
   IsValidEmail = false
   exit function
end if
if InStr(email, "..") > 0 then
   IsValidEmail = false
end if

end function

'将一文字中的HTML的标识去掉
Function FilterHTML(strToFilter)
Dim strTemp
strTemp = strToFilter
While Instr(1,strTemp,"<") AND Instr(1, strTemp, ">")
strTemp = Left(strTemp, Instr(1, strTemp, "<")-1) & Right(strTemp, Len(strTemp)-Instr(1,strTemp, ">"))
WEnd
FilterHTML = strTemp
End Function





'以下代码来自www本人还没有彻底修改完善
function ubb(strContent)
strContent = htmlencode(strContent)
dim re,ii,po
dim reContent
Set re=new RegExp
re.IgnoreCase =true
re.Global=True

re.Pattern="(javascript)"
strContent=re.Replace(strContent,"<I>&#106avascript</I>")
re.Pattern="(jscript"
strContent=re.Replace(strContent,"<I>&#106script:</I>")
re.Pattern="(js"
strContent=re.Replace(strContent,"<I>&#106s:</I>")
re.Pattern="(value)"
strContent=re.Replace(strContent,"<I>&#118alue</I>")
re.Pattern="(about"
strContent=re.Replace(strContent,"<I>about&#58</I>")
re.Pattern="(file:)"
strContent=re.Replace(strContent,"<I>file&#58</I>")
re.Pattern="(document.cookie)"
strContent=re.Replace(strContent,"<I>documents&#46cookie</I>")
re.Pattern="(vbscript:)"
strContent=re.Replace(strContent,"<I>&#118bscript:</I>")
re.Pattern="(vbs:)"
strContent=re.Replace(strContent,"<I>&#118bs:</I>")
re.Pattern="(on(mouse|exit|error|click|key))"
strContent=re.Replace(strContent,"<I>&#111n$2</I>")

re.Pattern="\[IMG\](.[^\[]*)\[\/IMG\]"
strContent=re.Replace(strContent,"<IMG SRC=""$1"" border=0>")
re.Pattern="\[IMG=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/IMG\]"
strContent=re.Replace(strContent,"<IMG SRC=""$3"" border=0 height=""$1"" width=""$2"">")

re.Pattern="(\[FLASH\])(.[^\[]*)(\[\/FLASH\])"
strContent= re.Replace(strContent,"<a href=""$2"" TARGET=_blank>[全屏欣赏]</a><br><OBJECT codeBase=./download/swflash.cab#version=6,0,29,0 classid=clsid27CDB6E-AE6D-11cf-96B8-444553540000 width=500 height=400><ARAM NAME=movie VALUE=""$2""><ARAM NAME=quality VALUE=high><embed src=""$2"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=400>$2</embed></OBJECT>")
re.Pattern="(\[FLASH=*([0-9]*),*([0-9]*)\])(.[^\[]*)(\[\/FLASH\])"
strContent= re.Replace(strContent,"<a href=""$4"" TARGET=_blank>[全屏欣赏]</a><br><OBJECT codeBase=./download/swflash.cab#version=6,0,29,0 classid=clsid27CDB6E-AE6D-11cf-96B8-444553540000 width=$2 height=$3><ARAM NAME=movie VALUE=""$4""><PARAM NAME=quality VALUE=high><embed src=""$4"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=$2 height=$3>$4</embed></OBJECT>")

re.Pattern="(\[URL\])(.[^\[]*)(\[\/URL\])"
strContent= re.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$2</A>")
re.Pattern="(\[URL=(.[^\[]*)\])(.[^\[]*)(\[\/URL\])"
strContent= re.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$3</A>")

re.Pattern="(\[EMAIL\])(\S+\@.[^\[]*)(\[\/EMAIL\])"
strContent= re.Replace(strContent,"<A HREF=""mailto2"">$2</A>")
re.Pattern="(\[EMAIL=(\S+\@.[^\[]*)\])(.[^\[]*)(\[\/EMAIL\])"
strContent= re.Replace(strContent,"<A HREF=""mailto2"" TARGET=_blank>$3</A>")

re.Pattern="\[color=(.[^\[]*)\](.[^\[]*)\[\/color\]"
strContent=re.Replace(strContent,"<font color=$1>$2</font>")
re.Pattern="\[font=(.[^\[]*)\](.[^\[]*)\[\/face\]"
strContent=re.Replace(strContent,"<font face=$1>$2</font>")
re.Pattern="\[align=(center|left|right)\](.*)\[\/align\]"
strContent=re.Replace(strContent,"<div align=$1>$2</div>")

re.Pattern="\[SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/SHADOW]"
strContent=re.Replace(strContent,"<table width=$1 ><tr><td style=""filter:shadow(color=$2, strength=$3)"">$4</td></tr></table>")
re.Pattern="\[GLOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/GLOW]"
strContent=re.Replace(strContent,"<table width=$1 ><tr><td style=""filter:glow(color=$2, strength=$3)"">$4</td></tr></table>")

re.Pattern="\[i\](.[^\[]*)\[\/i\]"
strContent=re.Replace(strContent,"<i>$1</i>")
re.Pattern="\[u\](.[^\[]*)(\[\/u\])"
strContent=re.Replace(strContent,"<u>$1</u>")
re.Pattern="\[b\](.[^\[]*)(\[\/b\])"
strContent=re.Replace(strContent,"<b>$1</b>")
re.Pattern="\[size=([1-4])\](.[^\[]*)\[\/size\]"
strContent=re.Replace(strContent,"<font size=$1>$2</font>")
strContent=replace(strContent,"<I></I>","")
set re=Nothing
ubb=strContent
end function

%>
发表于 2003-9-24 01:53:15 | 显示全部楼层
hoho,有点意思,不过动动脑子,算法还可以改进
发表于 2003-9-26 02:59:24 | 显示全部楼层
受教,受教,
以后多交流一下.
您需要登录后才可以回帖 登录 | 注-册-帐-号

本版积分规则

小黑屋|手机版|Archiver|数学建模网 ( 湘ICP备11011602号 )

GMT+8, 2024-11-27 01:36 , Processed in 0.058959 second(s), 19 queries .

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表