Web开发 – 第 15 页

&lt;% 
hehe = Hello("http://mmsg.qq.com/cgi-bin/gddylist?Type=13&amp;Sort=1&amp;Page=3", "&lt;html&gt;", "&lt;/html&gt;", ".*(&lt;td width=""35%"" bgcolor=""#[dABCDE]{6}""&gt;(.*)&lt;/td&gt;)[.
]*", "&lt;font style=""font-size:9pt;"" color=blue&gt;$2&lt;/font&gt;&lt;br&gt;") 
response.Write hehe 

Function Hello(strUrl, strStart, strEnd, patrn, replStr) 
Str = GetBody(strUrl) 
Str = MyMid(Str, strStart, strEnd) 
Str = ReplaceTest(patrn, replStr, Str) 
Hello = Str 
End Function 

Function MyMid(Str, strstart, strend) 
If strstart = "" Then 
i = 0 
Else 
i = InStr(Str, strstart) 
End If 
If strend = "" Then 
j = Len(Str) 
Else 
j = InStr(i, Str, strend) 
End If 
MyMid = Mid(Str, i, j - i + 1) 
End Function 

Function ReplaceTest(patrn, replStr, str1) 
Dim regEx, match, matches 
Set regEx = New RegExp 
regEx.Pattern = patrn 
regEx.IgnoreCase = True 
regEx.Global = True 
Set matches = regEx.Execute(str1) 
For Each match in matches 
ReplaceTest = ReplaceTest?Ex.Replace(Match.Value, replStr) 
Next 
End Function 

Function GetBody(Url) 
Set objXML = createObject("Microsoft.XMLHTTP") 
With objXML 
.Open "Get", Url, False, "", "" 
.SEnd 
GetBody = .ResponseBody 
End With 
GetBody = BytesToBstr(GetBody, "GB2312") 
Set objXML = Nothing 
End Function 

Function BytesToBstr(strBody, CodeBase) 
Set objStream = Server.createObject("Adodb.Stream") 
With objStream 
.Type = 1 
.Mode = 3 
.Open 
.Write strBody 
.Position = 0 
.Type = 2 
.Charset = CodeBase 
BytesToBstr = .ReadText 
.Close 
End With 
Set objStream = Nothing 
End Function 
%&gt;

hehe = Hello("http://mmsg.qq.com/cgi-bin/gddylist?Type=13&Sort=1&Page=3", "<html>", "</html>", ".*(<td width=""35%"" bgcolor=""#[dABCDE]{6}"">(.*)</td>)[.

]*", "$2 ")

response.Write hehe

Function Hello(strUrl, strStart, strEnd, patrn, replStr)

Str = GetBody(strUrl)

Str = MyMid(Str, strStart, strEnd)

Str = ReplaceTest(patrn, replStr, Str)

Hello = Str

End Function

Function MyMid(Str, strstart, strend)

If strstart = "" Then

i = 0

Else

i = InStr(Str, strstart)

End If

If strend = "" Then

j = Len(Str)

Else

j = InStr(i, Str, strend)

End If

MyMid = Mid(Str, i, j - i + 1)

End Function

Function ReplaceTest(patrn, replStr, str1)

Dim regEx, match, matches

Set regEx = New RegExp

regEx.Pattern = patrn

regEx.IgnoreCase = True

regEx.Global = True

Set matches = regEx.Execute(str1)

For Each match in matches

ReplaceTest = ReplaceTest?Ex.Replace(Match.Value, replStr)

End Function

Function GetBody(Url)

Set objXML = createObject("Microsoft.XMLHTTP")

With objXML

.Open "Get", Url, False, "", ""

.SEnd

GetBody = .ResponseBody

End With

GetBody = BytesToBstr(GetBody, "GB2312")

Set objXML = Nothing

End Function

Function BytesToBstr(strBody, CodeBase)

Set objStream = Server.createObject("Adodb.Stream")

With objStream

.Type = 1

.Mode = 3

.Open

.Write strBody

.Position = 0

.Type = 2

.Charset = CodeBase

BytesToBstr = .ReadText

.Close

End With

Set objStream = Nothing

End Function

[crayon-68666219a359a6 […]

ASP2006年10月17日2011年10月20日

XMLHTTP批量抓取远程资料

可以在此基础上结合正则表达式做成更好的效果，希望大家能分享一下Xmlhttp的session共享技术 [cra […]

ASP2006年10月17日

防采集而不防搜索引擎策略

从前面的我讲的采集原理大家可以看出，绝大多数采集程序都是靠分析规则来进行采集的，如分析分页文件名规则、分析页面 […]

ASP2006年10月17日

防采集策略

目前防采集的方法有很多种，先介绍一下常见防采集策略方法和它的弊端及采集对策：一、判断一个IP在一定时间内对本 […]

ASP2006年10月17日2011年10月3日

说采集就大家一起来聊采集吧

采集原理：采集程序的主要步骤如下：一、获取被采集的页面的内容二、从获取代码中提取所有用的数据一、获取被 […]

ASP2006年10月17日

论坛E-mail验正的正则表达式升级

今天拿到了传说中有1G大的Gmai,确实很好用速度极快，没有了传统的收件夹，取了代之的是labels ,用户自 […]

PHP2006年10月17日

一种PHP设计模式：DPT

一、DPT介绍 PHP为什么在主流的应用中总是那么不出色，总 […]