2006-5-22 文本转 HTML 与 HTML 转文本操作记录小结 By Stabx

本文链接：https://blog.csdn.net/btbtd/article/details/750608

标题: 文本转 HTML 与 HTML 转文本操作记录小结 By Stabx

正文:

文本与HTML 之间的互转, 主要是在添加更新数据与读取数据时用到.

添加数据与更新数据用文本转 HTML;
读取数据用 HTML 转文本.

表单 ttextarea 在读取数据时自动解码HTML字符, 有时对某些特定字符我们并不要这样, 这就需要HTML 转文本.

首先, 我需要的不是单纯的文本与 HTML 之间的互转, 加入了 UBB 开关选项, 加入了 HTML 开关选项, 2*2=4, 这需要四个判断.

文本转 HTML
1. 在输入了类似于 URL 地址栏之类的地址, 要求自动转为 URL 链接
2. 在输入了类似电子邮件之类的地址, 要求自动转为 EMAIL 链接.
3. 在输入了 UBB 标签时要求转换为相对的 HTML 标签.
4. 换行符,空格符,跳格符的格式都要保留, 这也许制造了不少垃圾, 但这比较以人为本, 为何要将就机器来着, 机器应该将就人.

注: 文本与HTML互转共用了五个函数来执行操作
//并用 ACCESS 的是/否数据类型来判断开关

添加更新数据时
1. textToHtml 主函数, 执行了转换HTML,转换UBB的功能
2. textToHtmlNullUBB 函数, 在 UBB 关, HTML 开时使用该函数
3. textToHtml1 在 UBB 与 HTML 都关时, 使用改函数

读取数据时
4. textToHtmlNullUBB1 在读取数据时使用该函数, 并且 UBB 关 HTML开时和 UBB HTML 都关时, 使用该函数
5. htmlToText 主函数, 在读取数据时使用该函数, 并且 UBB 开 HTML开时和 UBB 开 HTML 关时, 使用改函数

shawl.qiu
2006-5-22

 
  
    添加或更新数据时:  
   
 
   
文本 转 HTML | UBB 开关 与 HTML 开关相关逻辑  
     
                   title_=request.Form("title")
                 content_=request.Form("content") 
           if     htmloff_=1 and ubboff_=1  then 'html 和 ubb 都关闭则
                 title_=textToHtml1(trim(title_))
                 content_=textToHtml1(content_)
         end if
         if     htmloff_=0 and ubboff_=0  then 'html 和 ubb 都开启则
                 title_=textToHtml(trim(title_))
                 content_=textToHtml(content_)
         end if
         if htmloff_=0 and ubboff_=1 then 'HTML 开, UBB 关
                 title_=textToHtmlNullUBB(trim(title_)) 
                 content_=textToHtmlNullUBB(content_)
         end if
         if htmloff_=1 and ubboff_=0 then 'HTML 关, UBB 开
                 title_=textToHtml(trim(title_))
                 content_=textToHtml(content_)
         end if

 
  
    读取数据时: 
   
 
   
HTML 转 文本 | UBB 开关 与 HTML 开关相关逻辑  
   
             htmloff_=rs("htmloff") 
   
             ubboff_=rs("ubboff") 
   
             tt_=rs("title") 
   
             ct_=rs("content") 
   
     if     htmloff_=true and ubboff_=true  then 'UBB HTML 都关闭 
   
             tt_=tt_  
   
             ct_=textToHtmlNullUBB1(ct_) 
   
     end if 
   
     if     htmloff_=false and ubboff_=false  then  'UBB HTML 都开启 
   
             tt_=htmlToText(tt_) 
   
             ct_=htmlToText(ct_) 
   
     end if 
   
     if     ubboff_=true and htmloff_=false then 'UBB关, HTML 开 
   
             tt_=htmlToText(tt_) 
   
             ct_=htmlToText(ct_) 
   
     end if 
   
     if     ubboff_=false and htmloff_=true then 'UBB 开, HTML 关 
   
             tt_=textToHtmlNullUBB1(tt_) 
   
             ct_=textToHtmlNullUBB1(ct_) 
   
     end if

文本与 HTML 互转文件

<%
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' subject    : 文本转 HTML 与 HTML 转文本函数 By shawl.qiu
'
' writer    : Stabx<shawl.qiu@gmail.com>
'
' blog        : http://blog.csdn.net/btbtd / http://btbtd.exblog.jp/
'
' blog/site    : Phoenix.GI - P.GI / / 绿色学院 - Green Institute
'
' date        : 2006-5-22
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
function textToHtml(str)
     dim re
     if isNULL(str) then
     textToHtml=""
     exit function
     end if
         'str=replace(str,"&","&")
         str=replace(str,"/","\")
         str=replace(str,"'","'")
         str=replace(str,chr(34),""")
         str=replace(str,chr(32),"  ")
         str=replace(str,"<","<")
         str=replace(str,">",">")
         str=replace(str,chr(13),"
")
         str=replace(str,chr(9),"    ")
         str=replace(str,"ttextarea","ttextarea")
         str=replace(str,"[code]","[code]",1,-1,1)
         str=replace(str,"[/code]","[/code]",1,-1,1)
         str=replace(str,"[cite]","[cite]",1,-1,1)
         str=replace(str,"[/cite]","[/cite]")
         str=replace(str,"[quote]","[quote]",1,-1,1)
         str=replace(str,"[/quote]","[/quote]",1,-1,1)

    Set re = New RegExp
         re.Global = true
         re.IgnoreCase = true

        re.Pattern = "/[email/](.*)/[//email/]"
         str = re.Replace(str,"$1")
         '[email]shawl.qiu@gmail.com[/email]

         re.Pattern = "/[img/](.+)/[//img/]"
         str = re.Replace(str,"<img width=200 src=http://$1></img>")

         re.Pattern = "((http/:)|())([/w-]+/.+[/w-/.]+/.+[a-zA-Z0-9]+)(/:+[0-9]+/[/w-./?_%=&]*|/[/w-./?_%=&]*)?"
         str = re.Replace(str,"[url]$2$3$4$5[/url]")

         re.Pattern = "/[url/](.*?)/[//url/]"
         str = re.Replace(str,"$1")

        re.Pattern = "(([/w-]+/@+)|([/w-]+/.+[/w-]+/@+))(([/w-]+/.)([/w-]+/.)([a-zA-Z]+)|([/w-]+/.)([a-zA-Z]+))"
         str = re.Replace(str,"[email]$2$3$4[/email]")

         str=replace(str,"  "," ")

     textToHtml=str
end function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'文本转 HTML 函数不加 UBB
function textToHtmlNullUBB(str)
     dim re
     if isNULL(str) then
     textToHtmlNullUBB=""
     exit function
     end if
         str=replace(str,"&","&")
         str=replace(str,"'","'")
         str=replace(str,chr(34),""")
         str=replace(str,"<","<")
         str=replace(str,">",">")
         str=replace(str,chr(13),"
")
         str=replace(str,chr(9),"    ")
         str=replace(str,"ttextarea","ttextarea")
     textToHtmlNullUBB=str
end function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'文本转 HTML 1
function textToHtml1(str)
     if     str="" then
         exit function
     end if
         str=replace(str,"'","&#39")
         str=replace(str,"  "," ")
         str=replace(str,"ttextarea","ttextarea")
     textToHtml1=Str
end function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'文本转 HTML 函数不加 UBB
function textToHtmlNullUBB1(str)
     dim re
     if isNULL(str) then
     textToHtmlNullUBB=""
     exit function
     end if
         str=replace(str,"&","&")
         str=replace(str,"'","'")
         str=replace(str,chr(34),""")
         str=replace(str,"<","<")
         str=replace(str,">",">")
         str=replace(str,chr(9),"    ")
         str=replace(str,"ttextarea","ttextarea")
     textToHtmlNullUBB1=str
end function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'HTML 转文本
function htmlToText(str)
     Dim re
     if     str="" then
         exit function
     end if
         str=replace(str,"<","<")
         str=replace(str,">",">")
         str=replace(str,"ttextarea","ttextarea")
         str=replace(str,"[code]","[code]",1,-1,1)
         str=replace(str,"[/code]","[/code]",1,-1,1)
         str=replace(str,"[cite]","[cite]",1,-1,1)
         str=replace(str,"[/cite]","[/cite]",1,-1,1)
         str=replace(str,"[quote]","[quote]",1,-1,1)
         str=replace(str,"[/quote]","[/quote]",1,-1,1)
         str=replace(str,"
",chr(13),1,-1,1)

    Set re = New RegExp
         re.Global = true
         re.IgnoreCase = true

        re.Pattern = "<a.*?href=mailto/:.*?/>(.*?)/<//a/>"
         Str = re.Replace(Str,"[email]$1[/email]")

         re.Pattern = "<img.*?src=/:.*?/>(.*?)/<//img/>"
         Str = re.Replace(Str,"[img]$1[/img]")

        re.Pattern = "<a.*?href=http.*?/>(.*?)/<//a/>"
         Str = re.Replace(Str,"[url]$1[/url]")

     htmlToText=Str
end function
%>