自己写了一个函数,测试可以,但在程序里就报MID的错。
测试文件内容如下(可以正常使用):
<%
'*******************************************
'文本转换为Html
'*******************************************
Function Text2Html(Str1)
If isNULL(Str1) Then
Text2Html= " "
Exit Function
End If
Str1=Replace(Str1, "& ", "& ")
Str1=Replace(Str1, " < ", "< ")
Str1=Replace(Str1, "> ", "> ")
Str1=Replace(Str1,VBcrlf, " <br/> ")
Str1=Replace(Str1,chr(34), "" ")
Str1=Replace(Str1,chr(9), " ")
Str1=Replace(Str1, " ", " ")
Text2Html=Str1
End Function
'*****************************************************************************
'获取闭合的全部内容 '(目前只适合于以 <xxx> </xxx> 样式前后呼应的标记,比如 <table> </table> 、 <div> </div> 等)
'*****************************************************************************
Function CutSubContent(theContent1,theContent,startMark,theLen,theCount)
if trim(startMark) = " " then exit function
'获取开头标记和结束标记
MarkLen = Len(startMark)
startMark2 = Lcase(startMark)
startMark = " < " & startMark2 ' <td
endMark = " </ "& startMark2 ' </td
if Instr(theContent1,startMark) <= 0 then exit function
'先把标记之前的内容去掉
theContent1 = Mid(theContent1,Instr(theContent1,startMark))
'重新获得startMark2的值(为什么要重新获得呢?我不知道,反正不重新获得会出错。)
startMark2 = Right(startMark,len(startMark)-1)
If theLen = 0 Then
theLen = Abs(MarkLen + 2)
theContent = Mid(theContent1,theLen)
End If
if InStr(theContent,startMark) < InStr(theContent,endMark) Then '----------------------------------
if InStr(theContent,startMark) > 0 then
theLen = theLen + Abs(InStr(theContent,startMark)+MarkLen+1)
theContent = Mid(theContent1,theLen)
theCount = theCount + 1
else
theLen = theLen + Abs(InStr(theContent,endMark)+MarkLen+1)
theContent = Mid(theContent1,theLen)
theCount = theCount - 1
end if
If Abs(theCount) = 0 Then
response.write Text2Html(Mid(theContent1,1,Abs(theLen)))
response.End
Else
Call CutSubContent(theContent1,theContent,startMark2,theLen,theCount)
End if
Elseif InStr(theContent,startMark) > InStr(theContent,endMark) Then '------------------------------
theLen = theLen + Abs(InStr(theContent,endMark)+MarkLen+2)
theContent = Mid(theContent1,theLen)
theCount = theCount - 1
If Abs(theCount) = 0 Then
response.write Text2Html(Mid(theContent1,1,Abs(theLen-1)))
response.End
Else
Call CutSubContent(theContent1,theContent,startMark2,theLen,theCount)
End if
Else '-----------------------------------------------------
response.write Text2Html(Mid(theContent1,1,Abs(theLen)))
response.End
End If
End Function
if request.form( "content ") <> " " and request.form( "theIncStr ") <> " " Then
call CutSubContent(request.form( "content "),request.form( "content "),trim(request.form( "theIncStr ")),0,1)
end if
%>
<html>
<head>
<meta http-equiv= "Content-Language " content= "zh-cn ">
<meta http-equiv= "Content-Type " content= "text/html; charset=gb2312 ">
<title> 测试 </title>
</head>
<body>
<center>
<form method= "POST " name= "form1 " action= "index.asp ">
<p> <textarea rows= "19 " name= "content " cols= "67 "> <%=request.form( "content ")%> </textarea> </p>
<p> <select size= "1 " name= "theIncStr ">
<option value= " "> 请选择外围标记 </option>
<option value= "table "> table </option>
<option value= "tr "> tr </option>
<option value= "td "> td </option>
<option value= "div "> div </option>
<option value= "h1 "> h1 </option>
<option value= "h1 "> h2 </option>
<option value= "h1 "> h3 </option>
</select> </p>
<input type= "submit " value= "提交 " name= "B1 ">
<input type= "reset " value= "重置 " name= "B2 "> <a href= "index.asp "> 刷新页面 </a>
<p> </p>
</form>
</center>
</body>
</html>
[解决办法]
Private Function RegExReplacedString(strWord, PatternText)
PatternText = " < " & PatternText & "> | </ " & PatternText & "> "
Dim RegExCls
Set RegExCls = New RegExp
With RegExCls
.Pattern = PatternText
.IgnoreCase = true
.Global = True
End with
RegExReplacedString = RegExCls.Replace(strWord, " ")
End Function
Response.write (RegExReplacedString( " <table> <tr> <td> asdf <div> KKKKKK </div> adf </td> </tr> </table> "), " <table> ")
[解决办法]
Private Function RegExReplacedString(strWord, PatternText)
If PatternText = " " Then RegExReplacedString = strWord : Exit Function
Dim arrPatternText, i, tmpPatternText
tmpPatternText = " "
arrPatternText = Split(PatternText, ", ")
For i = 0 To Ubound(arrPatternText)
tmpPatternText = tmpPatternText & " < " & Trim(arrPatternText(i)) & ".*?> | </ " & Trim(arrPatternText(i)) & "> | "
Next
tmpPatternText = Left(tmpPatternText, Len(tmpPatternText) - 1)
Dim RegExCls
Set RegExCls = New RegExp
With RegExCls
.Pattern = tmpPatternText
.IgnoreCase = true
.Global = True
End with
RegExReplacedString = RegExCls.Replace(strWord, " ")
End Function
str = " <table> sfsdfdsfdKKKKK <div> sda </div> fdfdsf <tr> <td> adsfdsfdsa </td> </tr> dsfdsf sdfdsfdsfs </table> "
RegExReplacedString(str, "table, tr ") '以数组导入,一次性全部删除.
[解决办法]
可以.留给你作思考题吧.^___________^, 解决方法给你了,全替你写了,那你应该把你那份钱分我了.哈哈哈..
研究一下正则,对自己很有好处.