读书人

自己写了一个函数测试可以但在程序

发布时间: 2012-02-25 10:01:48 作者: rapoo

自己写了一个函数,测试可以,但在程序里就报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 ") '以数组导入,一次性全部删除.
[解决办法]
可以.留给你作思考题吧.^___________^, 解决方法给你了,全替你写了,那你应该把你那份钱分我了.哈哈哈..

研究一下正则,对自己很有好处.

读书人网 >ASP

热点推荐