最近写一个采集程序，然后就想到了通用分析网页再采集数据的方法，通过几天的摸索终于写出来了，与博客园的各位分享。
欢迎测试，欢迎指正，欢迎评论。
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 % >
吴烈 倾情制作。
304
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
