VB6.0使用正则表达式的有关问题

2013-07-04

VB6.0使用正则表达式的问题最近在学习用VB的XMLHTTP写爬虫，在分析网页源代码的时候遇到了这样一个问题：某

VB6.0使用正则表达式的问题
最近在学习用VB的XMLHTTP写爬虫，在分析网页源代码的时候遇到了这样一个问题：某些HTML标签是允许嵌套的，例如<DIV>；我现在的需求是获取被嵌套的子标签直接的内容，为此，我花了好久（本人接触正则表达式不久，属于菜鸟级的水平）写并测试了一个表达式，如下面几个函数所示：
'返回执行正则表达式后的匹配集合
Public Function RegExp(src As String, ptrn As String, Optional ic As Boolean = True, Optional gb As Boolean = True) As MatchCollection
Dim re As RegExp
    Set re = New RegExp
    With re
        .Pattern = ptrn
        .Global = gb
        .IgnoreCase = ic
    End With
    Set RegExp = re.Execute(src)
    Set re = Nothing
End Function
'非贪婪地获取成对出现的标签
Public Function GetSingleTagPair(tag As String, src As String) As MatchCollection
    Set GetSingleTagPair = RegExp(src, "<" & tag & ".*?>([\s\S](?!<" & tag & ".*?>))*?(</" & tag & ">)")End Function

红色部分就是我写的表达式。

我的测试文本是：
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<title>图书馆 v4.0 书目检索系统  我的图书馆</title>
<link type="text/css" rel="stylesheet" href="../tpl/css/base.css">
<link type="text/css" rel="stylesheet" href="../tpl/css/main.css">
<script src="../tpl/js/prototype.js"></script>
<script src="../tpl/js/highlighter.js"></script>
</head>

<body>
<body>
<div id="header">
   <div id="logo"><img src="../tpl/images/logo.jpg" width="76" height="44" /></div>
   <h1 class="font_30px">图书馆书目检索系统</h1>
   <div id="navlogin" >
             <a href="../reader/book_shelf.php">我的书架</a> | <a href="../reader/search_hist.php">我的检索历史</a>　
   </div>
</div>

<div id="menu">
    <ul>
      <li><a href="../opac/search.php">书目检索</a></li><li><a href="../opac/cls_browsing.php">分类浏览</a></li><li><a href="../opac/peri_nav_e.php">期刊导航</a></li><li><a href="../opac/newbook_cls_browse.php">新书通报</a></li><li><a href="../opac/virtual_shelf.php">公共书架</a></li><li><a href="../info/info_guide.php">信息发布</a></li><li><a href="../asord/asord_redr.php">读者荐购</a></li><li><a href="../reader/redr_cust_result.php"><b>我的图书馆</b></a></li>    </ul>
    <div style="color:#FFF; float:right;padding:5px 20px 0 0px">
    <img src="../tpl/images/icon_login.gif" width="16" height="11" /> xxx   <a href="../reader/logout.php"><strong style="color:red">注销</strong></a></div>

</div>
<div id="submenu">
  </div>

  <link type="text/css" rel="stylesheet" href="../tpl/css/mylib.css" /><LINK href="../tpl/css/tag-boxes.css" type="text/css" rel="stylesheet">
<script src="../tpl/js/ajax.js"></script>
<script src="../tpl/js/md5.js"></script>
<script src="../tpl/js/prototype.js"></script>
<script src="../tpl/js/xhconn.js"></script>
<script src="../tpl/js/tag-boxes.js"></script>
</head>
<body>
<div id="content" style="height:700px;">
  <div id="navsidebar">
     <ul id="nav_mylib">
     <li id="nav_mylibhome"><a href="redr_cust_result.php" >我的首页</a></li><li><a href="redr_info.php" >证件信息</a></li><li><a href="book_lst.php" >书刊借阅</a></li><li><a href="fine_pec.php" >违章缴款</a></li><li><a href="preg.php" >预约信息</a></li><li><a href="relegate.php" >委托信息</a></li><li><a href="book_loss.php" >书刊遗失</a></li><li><a href="redr_lost.php" >读者挂失</a></li><li><a href="account.php" >帐目清单</a></li><li><a href="asord_lst.php" >荐购历史</a></li><li><a href="book_rv.php" >我的书评</a></li><li><a href="book_push.php" >系统推荐</a></li><li><a href="book_shelf.php" >我的书架</a></li><li><a href="search_hist.php" >检索历史</a></li>
     </ul>
  </div>

  <div id="mylib_content">
<DIV id="head">
<div id="headTitle">
<table cellspacing="0" cellpadding="0" width="98%">
<tr><td align="left"><a style="text-decoration:underline;" onclick="displayHead();" href="#">我需要添加...</a></td>
<td align="right"><a style="text-decoration:underline;" onclick="saveApply();" href="#">保存设置</a></td>
</tr></table>
</div>
<div id="headBox" style="display:block" >
<p>提示：拖动您关注的内容的小图标到下面的页面域中。</p>
<ul id="dragableHeadUL">
</ul>
<div class="clear"></div>
<div id="validrssDiv" >  添加外部RSS源：<input type="text" style="height:14px;font-size:12px;" id="txt_rssurl" onkeyup="validInputText();" size=50 value="" /><input type="hidden" id="txt_rsstitle" /> <input type="button" id="btn_addurl" value="添加" disabled="disabled" style="height:24px; font-size:12px;"  onclick="addRssURL();"/> <input type="button" id="btn_cancel" value="重置" disabled="disabled" style="height:24px; font-size:12px;"  onclick="cancel();"/><span id="validinfo"></span></div>
<div class="clear"></div>
</div>
</div>
<DIV id="modules" >
  <div id="floatingBoxParentContainer"> </div>
  <div id="debugInfo" style="display:none"></div>
  <span id="ajax_validInfo" style="display:none"></span>
</div>
  </div>

</div>
<script type="text/javascript">
createColumns();
createHelpObjects();
initEvents();


   createAHead('','预约到书提醒','http://202.119.224.6:8080/reader/rss.php?type=1&id=5145583b0566553b55670a3a06310a395463', 5, 1);createAHead('','委托到书提醒','http://202.119.224.6:8080/reader/rss.php?type=2&id=5145583b0566553b55670a3a06310a395463', 5, 1);createAHead('','已超期图书提醒','http://202.119.224.6:8080/reader/rss.php?type=3&id=5145583b0566553b55670a3a06310a395463', 5, 1);createAHead('','即将到期的图书提醒','http://202.119.224.6:8080/reader/rss.php?type=4&id=5145583b0566553b55670a3a06310a395463', 5, 1);createAHead('','系统推荐','http://202.119.224.6:8080/reader/rss.php?type=5&id=5145583b0566553b55670a3a06310a395463', 5, 1);
</script>
<div id="footer"> <div id="copy">版权所有©<a target="_blank" href="http://www.libsys.com.cn">1999-2009 江苏汇文软件有限公司</a></div></body></html>

执行上面的函数返回的匹配集合是：
[1]<div id="logo"><img src="../tpl/images/logo.jpg" width="76" height="44" /></div>
[2]<div id="navlogin" >
             <a href="../reader/book_shelf.php">我的书架</a> | <a href="../reader/search_hist.php">我的检索历史</a>　
   </div>
[3]<div style="color:#FFF; float:right;padding:5px 20px 0 0px">
    <img src="../tpl/images/icon_login.gif" width="16" height="11" /> 唐锦渊   <a href="../reader/logout.php"><strong style="color:red">注销</strong></a></div>
[4]<div id="submenu">
  </div>
[5]<div id="navsidebar">
     <ul id="nav_mylib">
     <li id="nav_mylibhome"><a href="redr_cust_result.php" >我的首页</a></li><li><a href="redr_info.php" >证件信息</a></li><li><a href="book_lst.php" >书刊借阅</a></li><li><a href="fine_pec.php" >违章缴款</a></li><li><a href="preg.php" >预约信息</a></li><li><a href="relegate.php" >委托信息</a></li><li><a href="book_loss.php" >书刊遗失</a></li><li><a href="redr_lost.php" >读者挂失</a></li><li><a href="account.php" >帐目清单</a></li><li><a href="asord_lst.php" >荐购历史</a></li><li><a href="book_rv.php" >我的书评</a></li><li><a href="book_push.php" >系统推荐</a></li><li><a href="book_shelf.php" >我的书架</a></li><li><a href="search_hist.php" >检索历史</a></li>
     </ul>
  </div>
[6]<div id="headTitle">
<table cellspacing="0" cellpadding="0" width="98%">
<tr><td align="left"><a style="text-decoration:underline;" onclick="displayHead();" href="#">我需要添加...</a></td>
<td align="right"><a style="text-decoration:underline;" onclick="saveApply();" href="#">保存设置</a></td>
</tr></table>
</div>
[7]<div class="clear"></div>
[8]<div id="validrssDiv" >  添加外部RSS源：<input type="text" style="height:14px;font-size:12px;" id="txt_rssurl" onkeyup="validInputText();" size=50 value="" /><input type="hidden" id="txt_rsstitle" /> <input type="button" id="btn_addurl" value="添加" disabled="disabled" style="height:24px; font-size:12px;"  onclick="addRssURL();"/> <input type="button" id="btn_cancel" value="重置" disabled="disabled" style="height:24px; font-size:12px;"  onclick="cancel();"/><span id="validinfo"></span></div>

[9]<div class="clear"></div>
[10]<div id="floatingBoxParentContainer"> </div>
[11]<div id="debugInfo" style="display:none"></div>
[12]<div id="footer"> <div id="copy">版权所有©<a target="_blank" href="http://www.libsys.com.cn">1999-2009 江苏汇文软件有限公司</a></div>

观察结果：发现前11条记录符合要求，但是第12条记录理应被排除，但是却没有。这是为什么呢？正则表达式 Visual?Basic?6.0 爬虫
[解决办法]
仅供参考

Private Function StrFormat(s As String) As String
On Error Resume Next
Dim Buf As String
Dim StrTemp As String
Dim c As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim L As Long
    Buf = s
    Do
        L = InStr(1, Buf, "<style", vbTextCompare)
        If L > 0 Then
            k = InStr(L + 6, Buf, "</style>", vbTextCompare)
            If k > 0 Then
                Buf = Left(Buf, L - 1) + Mid(Buf, k + 8)
            Else
                Buf = Left(Buf, L - 1)
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
    Do
        L = InStr(1, Buf, "<script", vbTextCompare)
        If L > 0 Then
            k = InStr(L + 7, Buf, "</script>", vbTextCompare)
            If k > 0 Then
                Buf = Left(Buf, L - 1) + Mid(Buf, k + 9)
            Else
                Buf = Left(Buf, L - 1)
                Exit Do
            End If 
 
        Else
            Exit Do
        End If
    Loop
    Buf = Replace(Buf, "&amp;", "&")
    Buf = Replace(Buf, "&quot;", Chr(34)) '替换成双引号
    Buf = Replace(Buf, "&lt;", "<")
    Buf = Replace(Buf, "&gt;", ">")
    Buf = Replace(Buf, " ", "")
    Buf = Replace(Buf, "<", " <")
    Buf = Replace(Buf, ">", "> ")
    Buf = Replace(Buf, "&nbsp;", "")
    Buf = Replace(Buf, Chr(26), " ")
    Buf = Replace(Buf, Chr(10), " ")
    Buf = Replace(Buf, Chr(9), " ")
    Buf = Replace(Buf, Chr(13), " ")
    Buf = LTrim(Buf)
    Buf = RTrim(Buf)
    '您可加入其他替换
    StrTemp = ""
    For i = 1 To Len(Buf)
        c = Mid(Buf, i, 1)
        Select Case c
            Case "<"
                If i <> 1 Then
                    StrTemp = StrTemp & Mid(Buf, j + 1, i - j - 1)
                End If
            Case ">"
                j = i
        End Select
    Next i
    L = Len(StrTemp)
    Do
        Buf = Replace(StrTemp, "  ", " ")
        i = Len(Buf)
        If i = L Then Exit Do
        L = i
        StrTemp = Buf
    Loop
    StrFormat = Buf
End Function

[解决办法]

引用:

这个我也发现了，但是实在不明白为什么会这样。“先替换下以保证两个<div 不在同一行。”，不知道VB的正则表达式有没有内置的替换功能呢？

有啊，replace方法

reg.pattern="(<div.*?>)"
xxx=reg.repace(xxx,"$1" & vbcrlf)

热点排行