首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 网站开发 > ASP >

自己写了一个函数,测试可以,但在程序里就报MID的错。解决办法

2012-02-25 
自己写了一个函数,测试可以,但在程序里就报MID的错。测试文件内容如下(可以正常使用):%******************

自己写了一个函数,测试可以,但在程序里就报MID的错。
测试文件内容如下(可以正常使用):

<%
'*******************************************
'文本转换为Html
'*******************************************
Function   Text2Html(Str1)
If   isNULL(Str1)   Then
Text2Html= " "
Exit   Function
End   If
Str1=Replace(Str1, "& ", "&amp; ")
Str1=Replace(Str1, " < ", "&lt; ")
Str1=Replace(Str1, "> ", "&gt; ")
Str1=Replace(Str1,VBcrlf, " <br/> ")
Str1=Replace(Str1,chr(34), "&quot; ")
Str1=Replace(Str1,chr(9), "&nbsp;&nbsp;&nbsp; ")
Str1=Replace(Str1, "   ", "&nbsp; ")  
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 "> &nbsp;
<input   type= "reset "   value= "重置 "   name= "B2 "> &nbsp;&nbsp;   <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 ") '以数组导入,一次性全部删除.
[解决办法]
可以.留给你作思考题吧.^___________^, 解决方法给你了,全替你写了,那你应该把你那份钱分我了.哈哈哈..

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

热点排行