< %@LANGUAGE="VBSCRIPT " CODEPAGE="936"%>
<!-- #include file="conn.asp" -->
<!-- #include file="inc/function.asp" -->
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" " http://www.w3.org/TR/html4/loose.dtd ">
<html>
<голова>
<title>Документ без названия</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta http-equiv="refresh" content="300;URL=steal_house.asp">
</head>
<тело>
<%
при ошибке продолжить дальше
'
Сервер.ScriptTimeout = 999999
'============================================== =======
'字符编码函数
'============================================== ===
Функция BytesToBstr(тело,код)
тусклый объектный поток
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Открыть
objstream.Напишите тело
objstream.Position = 0
objstream.Type = 2
objstream.Charset = код
BytesToBstr = objstream.ReadText
objstream.Close
установить objstream = ничего
Конечная
функция
Функция Newsstring(wstr,strng)
Newstring=Instr(lcase(wstr),lcase(strng))
если Newstring<=0, то Newsstring=Len(wstr)
Конечная функция
'替换字符串函数
функция replaceStr(ori,str1,str2)
replaceStr=заменить(ori,str1,str2)
конечная функция
'============================================== ===
функция ReadXml(url,код,начало,окончание)
set oSend=createobject("Microsoft.XMLHTTP")
SourceCode = oSend.open ("GET",url,false)
oSend.send()
ReadXml=BytesToBstr(oSend.responseBody,code )
start=Instr(ReadXml,start)
ReadXml=mid(ReadXml,start)
Концы = Инстр (ReadXml, концы)
ReadXml=влево(ReadXml,ends-1)
функция завершения функции
SubStr(body,start,ends)
start=Instr(тело,начало)
SubStr=mid(body,start+len(start)+1)
Концы = Инстр (SubStr, концы)
SubStr=влево(SubStr,ends-1)
конечная функция
dim getcont,NewsContent
тусклый URL, заголовок
url=" http://www.***.com"'新闻网址knowsky.com
getcont=ReadXml(url,"gb2312","<table class=k2 border=""0""","</table>")
getcont = RegexHtml (getcont)
dim KeyId, NewsClass, City, Position, HouseType, Level, Area, Price, Demostra
dim ContactMan, ContactMan
для i=2 до ubound(getcont)
ответ.Write(getcont(i)&"__<br>")
tempLink=mid(getcont(i),instr(getcont(i),"href=""")+6,instr(getcont(i),""" onClick")-10)
tempLink=replace(tempLink,"../","")
ответ.Write(i&":"&tempLink&"<br>")
NewsContent=ReadXml(tempLink,"gb2312","<td valign=""bottom"" width=""400"">","<hr width=""760"" noshade size=""1"" color= ""#808080""> ")
NewsContent=RemoveHtml(NewsContent)
NewsContent=replace(NewsContent,VbCrLf,"")
NewsContent=replace(NewsContent,vbNewLine,"")
NewsContent=replace(NewsContent," ","")
NewsContent=replace(NewsContent," ","")
NewsContent=replace(NewsContent," ","")
NewsContent=replace(NewsContent,"n","")
NewsContent=replace(NewsContent,chr(10),"")
NewsContent=replace(NewsContent,chr(13),"")
'===============получить контент=======================
ответ.Запись(NewsContent)
KeyId=SubStr(NewsContent,"列号：","信息类别：")
NewsClass=SubStr(NewsContent,"类别：","所在城市：")
City=SubStr(NewsContent,"城市：","房屋具体位置：")
Position=SubStr(NewsContent,"位置：","房屋类型：")
HouseType=SubStr(NewsContent,"类型：","楼层：")
Level=SubStr(NewsContent,"楼层：","使用面积：")
Area=SubStr(NewsContent,"面积：","房价：")
Price=SubStr(NewsContent,"房价：","其他说明：")
Demostra=SubStr(NewsContent,"说明：","联系人：")
ContactMan=SubStr(NewsContent,"联系人：","联系方式：")
Contact=SubStr(NewsContent,"联系方式：","信息来源：")
response.Write("总序列号:"&KeyId&"<br>")
response.Write("信息类别:"&NewsClass&"<br>")
response.Write("所在城市:"&Город&"<br>")
response.Write("房屋具体位置:"&Position&"<br>")
response.Write("房屋类型:"&HouseType&"<br>")
response.Write("楼层:"&Level&"<br>")
response.Write("使用面积:"&Area&"<br>")
response.Write("房价:"&Price&"<br>")
response.Write("其他说明:"&Demostra&"<br>")
response.Write("联系人:"&ContactMan&"<br>")
response.Write("联系方式:"&Контакт&"<br>")
'title=RemoveHTML(aa(i))
'response.Write("title:"&title)
для n=0 в application.Contents.count
если(application.Contents(n)=KeyId) тогда
ifexit=истина
конец, если
следующий
если не ifexit, то
приложение(время&i)=KeyId
'添加到数据库
'============================================== ===
set rs=server.CreateObject("adodb.recordset")
rs.open "выбрать первые 1 * из новостей в порядке id desc",conn,3,3
rs.addnew
rs("НовостиКласс")=НовостиКласс
rs("Город")=Город
rs("Позиция")=Позиция
rs("Тип Дома")=Тип Дома
rs("Уровень")=Уровень
rs("Площадь")=Площадь
rs("Цена")=Цена
rs("Демостра")=Демостра
rs("ContactMan")=ContactMan
rs("Контакт")=Контакт
RS.обновление
RS.закрыть
установить rs=ничего
конец, если
'============================================== =
следующий
функция RemoveTag(body)
Set regEx = New RegExp
regEx.Pattern = "<[a].*?</[a]>"
regEx.IgnoreCase = Истина
regEx.Global = Истина
Установить совпадения = regEx.Execute(body)
дим я, обр(15),ifexit
я = 0
j=0
За каждый матч в матчах
TempStr = Соответствие.Значение
TempStr=replace(TempStr,"<td>","")
TempStr=replace(TempStr,"</td>","")
TempStr=replace(TempStr,"<tr>","")
TempStr=replace(TempStr,"</tr>","")
arr(i)=TempStr
я=я+1
если (я>= 15), то
выход для
конец, если
Следующий
Установить regEx=ничего
Установить совпадения = ничего
RemoveTag=обр.
конечная функция
функция RegexHtml(тело)
дим r_arr(47),r_temp
Установите regEx2 = Новое регулярное выражение.
regEx2.Pattern ="<a.*?</a>"
regEx2.IgnoreCase = Истина
regEx2.Global = Истина
Установите Matches2 = regEx2.Execute(body)
iii=0
За каждый матч в Matches2
r_arr(iii)=Match.Value
iii=iii+1
Следующий
RegexHtml=r_arr
установить regEx2=ничего
установить Matches2=ничего
конечная функция
'============================================== =====
конн.закрыть
установить соединение = ничего
%>
</тело>
</html>
функция.asp
<%
'************************************************ *
'函数名: gotTopic
'作 用: 截字符串, 汉字一个算两个字符, 英文算一个字符
'参 数:str ----原字符串
' strlen ----截取长度
'返回值: 截取后的字符串
'************************************************ *
функция gotTopic(str,strlen)
если ул="" тогда
gotTopic=""
функция выхода
конец, если
дим л, т, с, я
str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<" )
стр=заменить(стр,"?","")
л=лен(стр)
т=0
для я = от 1 до л
c=Abs(Asc(Mid(str,i,1)))
если с>255, то
т=т+2
еще
т=т+1
конец, если
если t>=strlen тогда
gotTopic=left(str,i) & "…"
выход для
еще
gotTopic=str
конец, если
следующий
gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<" )
конечная функция
'============================================== ========
'Добавление:RemoveHTML(strHTML)
'功能:去除HTML标记
'参数:strHTML --要去除HTML标记的字符串
'============================================== ========
Функция RemoveHTML(strHTML)
Dim objRegExp, Матч, Совпадения
Установить objRegExp = Новое регулярное выражение
objRegExp.IgnoreCase = True
objRegExp.Global = Истина
'取闭合的<>
objRegExp.Pattern = "<.+?>"
'进行匹配
Set Matches = objRegExp.Execute(strHTML)
' 遍历匹配集合，并替换掉匹配的项目
За каждый матч в матчах
strHtml=Заменить(strHTML,Match.Value,"")
Следующий
RemoveHTML=strHTML
Установить objRegExp = Ничего
установить совпадения = ничего
Конечная функция
%>
conn.asp
<%
'в случае ошибки продолжить дальше
set conn=server.CreateObject("adodb.connection")
con= "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath("stest.mdb")
conn.open с
субподключением
конн.закрыть
установить соединение = ничего
конец субтитра
%>
Номер: 抓取信息的详细页面事例
总序列号: | 479280 |
信息 | 类别 |
: | 出租 |
所在城市: | 济南 |
房屋具体位置: | 华龙Диапазон значений |
: | 24 |
～ | 240 пикселей.间 |
房价: | 0 [租赁:元/月,买卖:万元/套] |
其他说明: | 华信商务楼3至6层小空间对外出租（0,5元/平起），本楼属纯商务办公投资使用，可用于办公写字间，周边设施齐全、交通便利（37、80、K95在本楼前经过，全产权、市证，楼内设施包括水、电、暖、电梯设施齐全，有意者可电讯！ |
联系人: | 鲁、王 |
联系方式: | 88017966、86812217 |
信息来源: | 2005-8-4 8:28:55 Дата: 218.98.86.175 |
击次数: | 19 |