asp html解析，自己写的，通过测试。
最近写一个采集程序，然后就想到了通用分析网页再采集数据的方法，通过几天的摸索终于写出来了，与博客园的各位分享。
欢迎测试，欢迎指正，欢迎评论。
1 <%
2 ' asp html解析
3 '4 ' by 吴烈 xWorker.cn
5 ' 保留所有权利。不得用于商业用途，只能作为个人学习参考。
6 '
7 '===========================================================================================
8 '===========================================================================================
9 '=============== 处理函数 ==============================
10
11 '--------------------------------------------
12 ' 清除注释
13 function clearAnnotate(str)
14 dim re
15 set re = New RegExp
16 re.Global = True
17 re.IgnoreCase = True
18 re.Pattern = "\<!--.*-->"
19 clearAnnotate = re.Replace(str,"")
20 end function
21
22 '--------------------------------------------
23 ' 字符串转换成单字数组
24
25 function string2CharArray(str)
26 markDoubleChar = false ' 用来标识处理双字节
27 nIndex = 0 ' 有效字符编号
28 n = 0 ' 双字节数目
29 for i = 1 to len(str)
30 chrA = mid(str, i, 1)
31 if Asc(chrA) < 0 or Asc(chrA) > 255 then
32 ' 写入双字节
33 redim preserve sChar(nIndex + 1)
34 sChar(nIndex) = Mid(str, i, 1)
35
36 ' 写入双字节标识
37 redim preserve tChar(nIndex + 1)
38 tChar(nIndex) = 2
39
40 ' 增长索引号
41 nIndex = nIndex + 1
42
43 '标识中文
44 n = n + 1
45 else
46 ' 写入单字节
47 redim preserve sChar(nIndex + 1)
48 sChar(nIndex) = Mid(str, i, 1)
49
50 ' 写入单字节标识
51 redim preserve tChar(nIndex + 1)
52 tChar(nIndex) = 1
53
54 ' 增长索引号
55 nIndex = nIndex + 1
56 end if
57 next
58
59 '==========================================================================================================
60 ' 调试输出
61 if bDEBUG then
62 ' 输出调试
63 response.write "sChar个数:" & ubound(sChar) & "<br />"
64 response.write "中文个数:" & n & "<br />"
65 for i = 0 to (ubound(sChar) - 1) ' 参见注意1
66 response.write "tChar(" & i & ") 字节数: " & tChar(i) & " | 字符: " & sChar(i) & " | Acsii编码十进制: " & Asc(sChar(i)) & "<br />" & vbCrlf
67 next
68 end if
69
70 end function
71
72 '--------------------------------------------
73 ' 解析html, 生成多个有关系的数组
74 function htmlParse()
75 m =0
76 do
77 ch = GetCurrentChar()
78 '开始判断
79 if ch = "<" then
80 ch = getNextChar()
81 ascCh = Asc(ch)
82 if (ascCh >= Asc("A")) and (ascCh <= Asc("z")) then
83 ' 这样才是开始标签 <div
84 if newNode() <> 0 then '记录开始点, 这是"<"的位置
85 ' 出错了
86 end if
87 end if
88 elseif ch = "/" then
89 ch = getNextChar()
90 ascCh = Asc(ch)
91 if (ascCh >= Asc("A")) and (ascCh <= Asc("z")) then
92 ' 这样才是结束标签 /div>
93 ' 注意: 不能排除text/css
94 if closeNode() <> 0 then '记录开始点, 这是"/"的位置
95 ' 出错了
96 end if
97 end if
98 else
99 ' 在创建和关闭过程中自动获取标签内部文字
100 end if
101 m = m + 1
102 loop while moveNext()
103
104
105
106 '==================================================================================================
107 ' 调试输出
108 if bDEBUG then
109 ' 输出调试
110 response.write "循环" & m & "次<br />" & vbCrLf
111 end if
112 '==========================================================================================
113 ' 调试输出
114 if not bDEBUG then
115 response.write "<br />" & vbCrLf & "tagInfo Array:" & "<br />" & vbCrLf & "<br />" & vbCrLf
116 for i = 0 to (ubound(tagInfo) - 1)
117
118 response.write i & ": tagInfo(" & i & ") 自动编号: " & tagInfo(i)(0) & " 标签名称: " & tagInfo(i)(1) & " 标签类型: "& tagInfo(i)(2) & " 层次号: "& tagInfo(i)(3) & " 标签文字1: "& tagInfo(i)(4) & " 标签文字2: " & tagInfo(i)(5) & "<br />" & vbCrLf
119 next
120 end if
121
122 end function
123
124 '--------------------------------------------
125 '获取当前单字
126 function getCurrentChar()
127 getCurrentChar = sChar(index)
128 end function
129
130 '--------------------------------------------
131 '获取下一个单字
132 function getNextChar()
133 n = index + 1
134 getNextChar = sChar(n)
135 end function
136
137 '--------------------------------------------
138 '获取单字
139 function getChar(nIndex)
140 getChar = sChar(nIndex)
141 end function
142
143 '--------------------------------------------
144 ' 移动标识
145 function moveNext()
146 if index < nCharCount then
147 index = index + 1
148 moveNext = true
149 else
150 moveNext = false
151 end if
152 end function
153
154 '--------------------------------------------
155 ' 移动标识到 nIndex
156 function moveTo(nIndex)
157 if nIndex < nCharCount then
158 index = nIndex
159 moveTo = true
160 else
161 moveTo = false
162 end if
163 end function
164
165 '--------------------------------------------
166 ' 是否是尾部
167 function isEOF()
168 if index < nCharCount then
169 isEOF = true
170 else
171 isEOF = false
172 end if
173 end function
174
175 '--------------------------------------------
176 ' 时候是双字节
177 function isDoubleChar()
178 if tChar(index) = 2 then
179 isDoubleChar = true
180 else
181 isDoubleChar = false
182 end if
183
184 '===================================================================================================
185 ' 调试输出
186 sDEBUG = true
187 if sDEBUG then
188 ' 输出调试
189 response.write "tChar(" & index & ") 字节数:" & tChar(index) & "<br />" & vbCrLf
190 end if
191 end function
192
193 '--------------------------------------------
194 ' 新建一个节点，并返回详细信息
195 function newNode()
196 ' 新建标签
197 newTagReturn = newTag()
198 if 0 <> newTagReturn then
199 newNode = newTagReturn
200 ' 第一步出错，
201 end if
202 end function
203
204 '--------------------------------------------
205 ' 关闭一个节点，并返回详细信息
206 function closeNode()
207 ' 新建标签
208 closeTagReturn = closeTag()
209 if 0 <> closeTagReturn then
210 closeNode = closeTagReturn
211 ' 第一步出错，不是结束标签
212 end if
213 end function
214
215 '--------------------------------------------
216 ' 新建一个标签，并返回详细信息
217 function newTag()
218 ' 1 检查是否存在标签
219 ' 2 存储标签，并且移动标识到标签前部的末端 <td width="311" height="80" background="../images/title/330400.gif">
220 ' 3 标识当前父标签
221 ' 获取标签名称
222 tagName = getTagNameL()
223 tagNameLen = Len(tagName)
224 if isInTagNameArrayA(tagName) then ' 需配对的标签
225 ' 移动标识到标签左边末端
226 moveToTagLeftSide()
227
228 ' 写入tagInfo
229 redim preserve tagInfo(tagInfoIndex + 1)
230 tagInfo(tagInfoIndex) = Array(tagInfoIndex, tagName, "A", nodeUin, getTagTextL(), "")
231 ' 0 自动编号
232 ' 1 标签名称
233 ' 2 标签类型 A 或者 B
234 ' 3 层次号
235 ' 4 标签文字1
236 ' 5 标签文字2
237 tagInfoIndex = tagInfoIndex + 1
238
239 ' 写入 tempList 临时队列，一边配对
240 redim preserve tempList(tempListIndex + 1)
241 tempList(tempListIndex) = Array(tagInfoIndex - 1, tagName)
242 ' 标签编号
243 ' 标签名称
244 tempListIndex = tempListIndex + 1
245
246 ' 层结构加1
247 nodeUin = nodeUin + 1
248 elseif isInTagNameArrayB(tagName) then ' 不需配对的标签
249 ' 移动标识到标签左边末端
250 moveToTagLeftSide()
251
252 ' 写入tagInfo
253 redim preserve tagInfo(tagInfoIndex + 1)
254 tagInfo(tagInfoIndex) = Array(tagInfoIndex, tagName, "B", nodeUin, "", "")
255 '0 自动编号
256 '1 标签名称
257 '2 标签类型 A 或者 B
258 '3 层次号
259 '4 标签文字1
260 '5 标签文字2
261 tagInfoIndex = tagInfoIndex + 1
262
263 ' 层结构不变
264 else
265 ' 标签名不存在
266 response.Write "标签名: " & tagName & " 不存在 <br />" & vbCrLf
267 end if
268
269 ' 返回
270 newTag = 0
271
272
273 '==========================================================================================
274 ' 调试输出
275 if bDEBUG then
276 response.write index & " : " & tagName & " len: " & Len(tagName) & "<br />" & vbCrLf
277 i = tagInfoIndex - 1
278 response.write " tagInfo(" & i & ") 自动编号: " & tagInfo(i)(0) & " 标签名称: " & tagInfo(i)(1) & " 标签类型: "& tagInfo(i)(2) & " 父节点编号: "& tagInfo(i)(3) & " 标签文字1: "& tagInfo(i)(4) & " 标签文字2: " & tagInfo(i)(5) & "<br />" & vbCrLf
279 end if
280 end function
281
282 '--------------------------------------------
283 ' 关闭一个标签，并返回详细信息
284 function closeTag()
285 ' 1 检查是否存在标签
286 ' 2 存储标签，并且移动标识到标签前部的末端 <td width="311" height="80" background="../images/title/330400.gif">
287 ' 3 标识当前父标签
288
289 ' 没有A标签
290 if nodeUin = 0 then
291 closeTag = 2
292 exit function
293 end if
294 ' 标签名称
295 tagNameR = getTagNameR()
296 ' 排除text/css的情况，再次确认是否是结束标签
297 if not (isInTagNameArrayA(tagNameR) or isInTagNameArrayB(tagNameR)) then
298 closeTag = 1
299 exit function
300 end if
301 ' 获得标签内部右边的文字
302 tagTextR = getTagTextR()
303 ' 移动标识到末端 当前/ 移动到 > /div>
304 moveTo(index + Len(tagNameR) + 1)
305 ' 获取标签id
306 tagId = 0
307 for i = (ubound(tempList) - 1) to 0 step -1
308 if tempList(i)(1) = tagNameR then
309 tagId = tempList(i)(0)
310 ' 更改 tempList 记录
311 tempList(i)(1) = "NullTagName"
312 ' 减小层结构数
313 nodeUin = nodeUin - 1
314 exit for
315 end if
316 next
317
318 ' 比对左边文本，并写入
319 if tagInfo(tagId)(4) <> tagTextR then
320 tagInfo(tagId)(5) = tagTextR
321 else
322 tagInfo(tagId)(5) = ""
323 end if
324
325
326 end function
327
328 '--------------------------------------------
329 ' 获取一个标签名称(左边)
330 ' 标识位置: <
331 function getTagNameL()
332 n = 0
333 tTagName = ""
334 do while (isEOF() and n < 9)
335 ch = getChar(index + n + 1)
336 if ch = Chr(32) or ch = Chr(62) then
337 for i = 1 to n
338 tTagName = tTagName & sChar(index + i)
339 next
340 exit do
341 end if
342 n = n + 1
343 loop
344 getTagNameL = tTagName
345 end function
346
347 '--------------------------------------------
348 ' 获取一个标签名称(右边)
349 ' 标识位置: /
350 function getTagNameR()
351 n = 0
352 tTagName = ""
353 do while (isEOF() and n < 9)
354 ch = getChar(index + n + 1)
355 if ch = Chr(62) then
356 for i = 1 to n
357 tTagName = tTagName & sChar(index + i)
358 next
359 exit do
360 end if
361 n = n + 1
362 loop
363 getTagNameR = tTagName
364 end function
365
366 '--------------------------------------------
367 ' 移动标识到标签左边末端
368 ' 当前标识: >
369 function moveToTagLeftSide()
370 n = 0
371 do while isEOF()
372 ch = getChar(index + n + 1)
373 if ch = ">" then
374 moveTo(index + n + 1)
375 moveToTagLeftSide = true
376 exit function
377 end if
378 n = n + 1
379 loop
380 '
381 moveToTagLeftSide = false
382 end function
383
384 '--------------------------------------------
385 ' 是否是A标签(有配对的标签)
386 function isInTagNameArrayA(sTagName)
387 for each tagName in tagNameArrayA
388 if tagName = sTagName then
389 ' 找到就返回
390 isInTagNameArrayA = true
391 exit function
392 end if
393 next
394 ' 表示没有找到
395 isInTagNameArrayA = false
396 end function
397
398 '--------------------------------------------
399 ' 是否是B标签(不需配对的标签)
400 function isInTagNameArrayB(sTagName)
401 for each tagName in tagNameArrayB
402 if tagName = sTagName then
403 ' 找到就返回
404 isInTagNameArrayB = true
405 exit function
406 end if
407 next
408 ' 表示没有找到
409 isInTagNameArrayB = false
410 end function
411
412 '--------------------------------------------
413 ' 获得标签内部左边的文本
414 function getTagTextL()
415 ' 此时标识已经是末端了
416 n = 0
417 tTagText = ""
418 do while isEOF()
419 ch = getChar(index + n + 1)
420 if ch = Chr(60) then
421 for i = 1 to n
422 tTagText = tTagText & sChar(index + i)
423 next
424 exit do
425 end if
426 n = n + 1
427 loop
428 getTagTextL = tTagText
429 end function
430
431 '--------------------------------------------
432 ' 获得标签内部右边的文本
433 function getTagTextR()
434 ' 此时标识已经是末端了
435 n = 0
436 tTagText = ""
437 do while isEOF()
438 ch = getChar(index - n - 1)
439 if ch = ">" then
440 for i = n to 2 step -1
441 tTagText = tTagText & sChar(index - i)
442 next
443 exit do
444 end if
445 n = n + 1
446 loop
447 getTagTextR = tTagText
448 end function
449
450 '--------------------------------------------
451 ' 是否是B标签()
452 function isInTagrayB(sTagName)
453
454 end function
455
456 '--------------------------------------------
457 ' 是否是B标签()
458 function isInTgNmeArrayB(sTagName)
459
460 end function
461
462 '--------------------------------------------
463 ' 是否是B标签()
464 function isInTagameArayB(sTagName)
465
466 end function
467
468 '--------------------------------------------
469 ' 使用FSO读取文件内容的函数
470 function FSOFileRead(filename)
471 dim objFSO, objCountFile, FiletempData
472 set objFSO = Server.CreateObject("Scripting.FileSystemObject")
473 set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename), 1, true)
474 FSOFileRead = objCountFile.ReadAll
475 objCountFile.Close
476 set objCountFile = nothing
477 set objFSO = nothing
478 end function
479
480
481
482
483 '===========================================================================================
484 '===========================================================================================
485 '========================= 执行体 ===============================
486 ' 一些设置
487 bDEBUG = false
488
489 ' 注意这个文件
490 htmlStr = FSOFileRead("test.html")
491
492 'htmlStr = "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312""><html xmlns=""http://www.w3.org/1999/xhtml""><html><head><meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312""><title>朱自成的个人简历-路桥技术/隧道工程·工民建·土建工程师 | 12年工作经验 | 大专 | 路桥 嘉兴人才招聘网</title><meta NAME=""keywords"" content=""嘉兴人才网,嘉兴人才招聘网,嘉兴人才市场,嘉兴招聘网,嘉兴人才网,嘉兴人才招聘网-打造嘉兴最好的人才招聘网站 口碑铸就人气！,http://www.0573hr.com.cn""><meta name=""description"" content=""嘉兴人才网,嘉兴人才招聘网,嘉兴人才市场,嘉兴招聘网,嘉兴人才网,嘉兴人才招聘网-打造嘉兴最好的人才招聘网站 口碑铸就人气！,http://www.0573hr.com.cn"" ><link href=""images/grjl.css"" rel=""stylesheet"" type=""text/css""></head><body><table width=""991"" border=""0"" cellspacing=""0"" cellpadding=""0""><tr><td width=""311"" height=""80"" valign=""bottom"" background=""../images/title/330400.gif""><table width=""275"" border=""0"" align=""right"" cellpadding=""0"" cellspacing=""0""><tr><td width=""266"" height=""35"" class=w>求职<b>嘉兴人才招聘网</b>--打造嘉兴最好的人才招聘网站</td></tr></table></td></tr></table><div>name</div></body></html>"
493
494 '<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
495 '<html xmlns="http://www.w3.org/1999/xhtml">
496 ' <html>
497 ' <head>
498 ' <meta http-equiv="Content-Type" content="text/html; charset=gb2312">
499 ' <title>朱自成的个人简历-路桥技术/隧道工程·工民建·土建工程师 | 12年工作经验 | 大专 | 路桥 嘉兴人才招聘网</title>
500 ' <meta NAME="keywords" content="嘉兴人才网,嘉兴人才招聘网,嘉兴人才市场,嘉兴招聘网,嘉兴人才网,嘉兴人才招聘网-打造嘉兴最好的人才招聘网站 口碑铸就人气！,http://www.0573hr.com.cn">
501 ' <meta name="description" content="嘉兴人才网,嘉兴人才招聘网,嘉兴人才市场,嘉兴招聘网,嘉兴人才网,嘉兴人才招聘网-打造嘉兴最好的人才招聘网站 口碑铸就人气！,http://www.0573hr.com.cn" >
502 ' <link href="images/grjl.css" rel="stylesheet" type="text/css">
503 ' </head>
504 ' <body>
505 ' <table width="991" border="0" cellspacing="0" cellpadding="0">
506 ' <tr>
507 ' <td width="311" height="80" valign="bottom" background="../images/title/330400.gif">
508 ' <table width="275" border="0" align="right" cellpadding="0" cellspacing="0">
509 ' <tr>
510 ' <td width="266" height="35" class=w>
511 ' 求职
512 ' <b>
513 ' 嘉兴人才招聘网
514 ' </b>
515 ' --打造嘉兴最好的人才招聘网站
516 ' </td>
517 ' </tr>
518 ' </table>
519 ' </td>
520 ' </tr>
521 ' </table>
522 ' <div>
523 ' name
524 ' </div>
525 ' </body>
526 ' </html>
527
528 ' 1 网页字符串预处理
529 ' --------------------------------------------------------------------------------------------------
530
531 ' 1.0 按行读取，清楚左边空格，再合并
532 tCharArray = split(htmlStr, vbCrLf)
533 htmlStr = ""
534 for j = 0 to Ubound(tCharArray)
535 htmlStr = htmlStr + Trim(tCharArray(j))
536 next
537 ' 全部转换成小写
538 htmlStr = LCase(htmlStr)
539 ' 1.1 清除注释
540 htmlStr = clearAnnotate(htmlStr)
541
542 response.write "经过处理后的htmlStr文字个数: " & Len(htmlStr) & "<br />" & vbCrLf
543
544 ' 1.2 将字符串裁剪成单个字符，注意非英文的，并且记录是否是英文
545 dim sChar() ' 字符串单字数组
546 dim tChar() ' 记录单字是否为多字节
547 string2CharArray(htmlStr) ' 注意1: 这样最后下标的数组是空的
548
549
550 ' 2 生成html标签树
551 ' --------------------------------------------------------------------------------------------------
552 index = 0 ' 当前单字下标标识
553 nCharCount = ubound(sChar) - 1 ' 字符数 (实际 + 1)
554 nCurrentFatherTag = 0 ' 当前父标签下标，用来处理 <A>文本段1<B>文本段2</B>文本段3</A> 这样的情况
555 lastTagType = "A"
556 '有配对的标签
557 tagNameArrayA = Array("html", "body", "head", "title", "p", "center", "pre", "div", "nobr", "wbr", "strong", "b", "em", "i", "tt", "u", "h1", "h2", "h3", "h4", "", "h5", "h6", "font", "basefont", "big", "small", "strike", "code", "kbd", "samp", "var", "cite", "blockquote", "dfn", "address", "sub", "sup", "ol", "ul", "li", "menu", "dir", "dl", "dt", "dd", "table", "caption", "tr", "td", "th", "form", "textarea", "input", "select", "option", "a", "frameset", "iframe", "noframes", "map", "marquee", "blink", "style", "span")
558 '不需配对的标签
559 tagNameArrayB = Array("!doctype", "br", "hr", "input", "img", "base", "frame", "area", "bgsound", "meta", "link")
560 dim nodeInfo()
561 nodeInfoIndex = 0
562 ' 层次号
563 nodeUin = 0
564 nodeInfoID = 0
565 ' nodeInfo
566 ' 自动编号
567 ' 层数
568 ' 子节点数
569 dim tagInfo()
570 tagInfoIndex = 0
571 tagInfoID =0
572 ' tagInfo
573 ' 自动编号
574 ' 标签名称
575 ' 标签类型 A 或者 B
576 ' 层次号
577 ' 标签文字1
578 ' 标签文字2
579 dim tempList()
580 tempListID = 0
581 tempListIndex = 0
582 ' tempList 临时队列
583 ' 标签名称
584
585 ' 解析html, 生成多个有关系的数组
586 htmlParse()
587 %>
吴烈 倾情制作。
