< %@LANGUAGE="VBSCRIPT " CODEPAGE="936"%>
<!-- #include file="conn.asp" -->
<!-- #include file="inc/function.asp" -->
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transisi//EN" " http://www.w3.org/TR/html4/loose.dtd ">
<html>
<kepala>
<title>Dokumen Tanpa Judul</title>
<meta http-equiv="Jenis Konten" content="teks/html; charset=gb2312">
<meta http-equiv="refresh" content="300;URL=steal_house.asp">
</kepala>
<tubuh>
<%
pada kesalahan lanjutkan berikutnya
'
Server.ScriptTimeout = 999999
' ===== =======
'字符编码函数
' ===== ===
Fungsi BytesToBstr(tubuh,kode)
objek redup
setel objstream = Server.CreateObject("adodb.stream")
objstream.Jenis = 1
objstream.Mode =3
objstream.Buka
objstream.Tulis isi
objstream.Posisi = 0
objstream.Jenis = 2
objstream.Charset =kode
BytesToBstr = objstream.ReadText
objstream.Tutup
setel objstream = tidak ada
Fungsi Akhir
'取行字符串在另一字符串中的出现位置
Fungsi String Baru(wstr,strng)
String baru=Instr(lcase(wstr),lcase(strng))
jika Newstring<=0 maka Newstring=Len(wstr)
Fungsi Akhir
'替换字符串函数
fungsi GantiStr(ori,str1,str2)
GantiStr=ganti(ori,str1,str2)
fungsi akhir
' ===== ===
fungsi ReadXml(url,kode,mulai,berakhir)
setel oSend=buat objek("Microsoft.XMLHTTP")
SourceCode = oSend.open ("GET",url,false)
oKirim.kirim()
ReadXml=BytesToBstr(oSend.responseBody,kode )
mulai=Instr(ReadXml,mulai)
ReadXml=pertengahan(ReadXml,mulai)
berakhir=Instr(ReadXml,berakhir)
ReadXml=kiri(ReadXml,berakhir-1)
fungsi akhir
fungsi SubStr(tubuh,awal,akhir)
mulai=Instr(tubuh,mulai)
SubStr=pertengahan(tubuh,mulai+len(mulai)+1)
berakhir=Instr(SubStr,berakhir)
SubStr=kiri(SubStr,berakhir-1)
fungsi akhir
redupkan getcont,NewsContent
url redup, judul
url=" http://www.***.com"'新闻网址knowsky.com
getcont=ReadXml(url,"gb2312","<table class=k2 border=""0""","</table>")
getcont=RegexHtml(getcont)
redupkan KeyId,Kelas Berita,Kota,Posisi,Tipe Rumah,Level,Area,Harga,Demostra
redupkan ContactMan,Kontak
untuk i=2 hingga ubound(getcont)
respon.Tulis(getcont(i)&"__<br>")
tempLink=mid(getcont(i),instr(getcont(i),"href=""")+6,instr(getcont(i),""" onClick")-10)
tempLink=ganti(tempLink,"../","")
respon.Tulis(i&":"&tempLink&"<br>")
NewsContent=ReadXml(tempLink,"gb2312","<td valign=""bottom"" width=""400"">","<hr width=""760"" noshade size=""1"" color= ""#808080""> ")
Konten Berita=RemoveHtml(Konten Berita)
Konten Berita=ganti(Konten Berita,VbCrLf,"")
Konten Berita=ganti(Konten Berita,vbNewLine,"")
KontenBerita=ganti(KontenBerita," ","")
KontenBerita=ganti(KontenBerita," ","")
KontenBerita=ganti(KontenBerita," ","")
KontenBerita=ganti(KontenBerita,"n","")
Konten Berita=ganti(Konten Berita,chr(10),"")
Konten Berita=ganti(Konten Berita,chr(13),"")
'===============dapatkan Konten========
respon.Tulis(Konten Berita)
KeyId=SubStr(Konten Berita,"列号：","信息类别：")
NewsClass=SubStr(Konten Berita,"类别：","所在城市：")
Kota=SubStr(Konten Berita,"城市：","房屋具体位置：")
Position=SubStr(Konten Berita,"位置：","房屋类型：")
HouseType=SubStr(Konten Berita,"类型：","楼层：")
Level=SubStr(Konten Berita,"楼层：",,"使用面积：")
Area=SubStr(Konten Berita,"面积：","房价：")
Harga=SubStr(Konten Berita,"房价：","其他说明：")
Demostra=SubStr(Konten Berita,"说明：","联系人：")
ContactMan=SubStr(NewsContent,"联系人：","联系方式：")
Kontak=SubStr(Konten Berita,"联系方式：","信息来源：")
respon.Write("总序列号:"&KeyId&"<br>")
respon.Write("信息类别:"&Kelas Berita&"<br>")
respon.Write("所在城市:"&Kota&"<br>")
respon.Write("房屋具体位置:"&Posisi&"<br>")
respon.Write("房屋类型:"&Tipe Rumah&"<br>")
respon.Tulis("楼层:"&Level&"<br>")
respon.Write("使用面积:"&Area&"<br>")
respon.Write("房价:"&Harga&"<br>")
respon.Write("其他说明:"&Demostra&"<br>")
respon.Write("联系人:"&ContactMan&"<br>")
respon.Write("联系方式:"&Kontak&"<br>")
'judul=HapusHTML(aa(i))
'respons.Write("judul:"&judul)
untuk n=0 ke application.Contents.count
if(application.Contents(n)=KeyId) lalu
ifexit=benar
berakhir jika
Berikutnya
jika tidak, keluarlah
aplikasi(waktu&i)=Id Kunci
'添加到数据库
' ===== ===
setel rs=server.CreateObject("adodb.recordset")
rs.open "pilih 1 teratas * dari urutan berita berdasarkan id desc", samb,3,3
rs.tambahkan baru
rs("Kelas Berita")=Kelas Berita
rs("Kota")=Kota
rs("Posisi")=Posisi
rs("Tipe Rumah")=Tipe Rumah
rs("Tingkat")=Tingkat
rs("Luas")=Luas
rs("Harga")=Harga
rs("Demostra")=Demostra
rs("Manusia Kontak")=Manusia Kontak
rs("Kontak")=Kontak
rs.update
rs.tutup
atur rs=tidak ada
berakhir jika
' ===== =
Berikutnya
fungsi HapusTag(tubuh)
Setel regEx = RegExp Baru
regEx.Pattern = "<[a].*?</[a]>"
regEx.IgnoreCase = Benar
regEx.Global = Benar
Setel Kecocokan = regEx.Execute(body)
redupkan aku, arr (15), jika keluar
saya=0
j=0
Untuk Setiap Pertandingan dalam Pertandingan
TempStr = Cocok.Nilai
TempStr=ganti(TempStr,"<td>","")
TempStr=ganti(TempStr,"</td>","")
TempStr=ganti(TempStr,"<tr>","")
TempStr=ganti(TempStr,"</tr>","")
arr(i)=TempStr
saya=saya+1
jika(i>=15) maka
keluar untuk
berakhir jika
Berikutnya
Setel regEx=tidak ada
Tetapkan Kecocokan = tidak ada
HapusTag=arr
fungsi akhir
fungsi RegexHtml(tubuh)
redup r_arr(47),r_temp
Setel regEx2 = RegExp Baru
regEx2.Pattern ="<a.*?</a>"
regEx2.IgnoreCase = Benar
regEx2.Global = Benar
Setel Matches2 = regEx2.Execute(body)
aku aku aku=0
Untuk Setiap Pertandingan di Pertandingan2
r_arr(iii)=Nilai Cocok
iii=iii+1
Berikutnya
RegexHtml=r_arr
atur regEx2=tidak ada
setel Cocok2=tidak ada
fungsi akhir
' ===== =====
samb.tutup
setel samb=tidak ada
%>
</tubuh>
</html>
fungsi.asp
<%
'****************************************************** *
'函数名：dapat Topik
'作 用：截字符串，汉字一个算两个字符，英文算一个字符
'参 数：str ----原字符串
' strlen ----截取长度
'返回值：截取后的字符串
'****************************************************** *
fungsi gotTopic(str,strlen)
jika str = "" maka
mendapatTopik=""
fungsi keluar
berakhir jika
redup l,t,c, i
str=ganti(ganti(ganti(ganti(str," "," "),""",chr(34)),">",">"),"<","<" )
str=ganti(str,"?","")
aku=len(str)
t=0
untuk i=1 sampai l
c=Abs(Asc(Tengah(str,i,1)))
jika c>255 maka
t=t+2
kalau tidak
t=t+1
berakhir jika
jika t>=strlen maka
gotTopic=kiri(str,i) & "..."
keluar untuk
kalau tidak
mendapatTopik=str
berakhir jika
Berikutnya
gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<" )
fungsi akhir
' ===== ========
'函数：HapusHTML(strHTML)
'功能：去除HTML标记
'参数：strHTML --要去除HTML标记的字符串
' ===== ========
Fungsi HapusHTML(strHTML)
Redupkan objRegExp, Cocok, Cocok
Setel objRegExp = Regexp baru
objRegExp.IgnoreCase = Benar
objRegExp.Global = Benar
'取闭合的<>
objRegExp.Pattern = "<.+?>"
'进行匹配
Setel Kecocokan = objRegExp.Execute(strHTML)
'
Untuk Setiap Pertandingan dalam Pertandingan
strHtml=Ganti(strHTML,Match.Value,"")
Berikutnya
HapusHTML=strHTML
Setel objRegExp = Tidak Ada
set Cocok = tidak ada
Fungsi Akhir
%>
samb.asp
<%
'pada kesalahan lanjutkan berikutnya
setel koneksi=server.CreateObject("adodb.koneksi")
con= "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath("stest.mdb")
samb.buka dengan
subsimpulan
samb.tutup
setel samb=tidak ada
sub akhir
%>
附：抓取信息的详细页面事例
总序列号： | 479280 |
信息类别： | 出租 |
所在城市： | 济南 |
房屋具体位置： | 华龙路华信路交界口 |
房屋类型： | 其他 |
楼层： | 六层 |
使用面积： | 24～240 平方米之间 |
房价： | 0 [租赁:元/月,买卖:万元/套] |
其他说明： | 华信商务楼3至6层小空间对外出租（0,5元/平起）,本楼属纯商务办公投资使用,可用于办公写字间,周边设施齐全、交通便利（37、80、K95在本楼前经过），全产权、市证，楼内设施包括水、电、暖、电梯设施齐全，有意者可电讯！ |
联系Nomor 人： | 鲁、王 |
联系方式： | 88017966、86812217 |
信息来源： | 4-8-2005 8:28:55 tanggal：218.98.86.175 |
点击次数： | 19 |