< %@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>
<Kopf>
<title>Unbenanntes Dokument</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta http-equiv="refresh" content="300;URL=steal_house.asp">
</head>
<body>
<%
Bei Fehler als nächstes fortfahren
'
Server.ScriptTimeout = 999999
'============================================== =======
'字符编码函数
'============================================== ===
Funktion BytesToBstr(body,code)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Öffnen
objstream.Text schreiben
objstream.Position = 0
objstream.Type = 2
objstream.Charset =code
BytesToBstr = objstream.ReadText
objstream.Schließen
set objstream = nichts
Endfunktion
'取行字符串在另一字符串中的出现位置
Funktion Newstring(wstr,strng)
Newstring=Instr(lcase(wstr),lcase(strng))
wenn Newstring<=0 dann Newstring=Len(wstr)
Funktion beenden
'替换字符串函数
Funktion ErsetzenStr(ori,str1,str2)
ErsetzenStr=ersetzen(ori,str1,str2)
Endfunktion
'============================================== ===
Funktion ReadXml(URL,Code,Start,Enden)
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)
endet=Instr(ReadXml,ends)
ReadXml=left(ReadXml,ends-1)
Endfunktion
Funktion SubStr(body,start,ends)
start=Instr(body,start)
SubStr=mid(body,start+len(start)+1)
endet=Instr(SubStr,ends)
SubStr=left(SubStr,ends-1)
Endfunktion
dim getcont,NewsContent
URL und Titel dimmen
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,Contact
für i=2 zu ubound(getcont)
Antwort.Write(getcont(i)&"__<br>")
tempLink=mid(getcont(i),instr(getcont(i),"href=""")+6,instr(getcont(i),""" onClick")-10)
tempLink=replace(tempLink,"../","")
Antwort.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),"")
'===============Inhalt abrufen=======================
Antwort.Write(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("所在城市:"&City&"<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("Kontakt:"&Kontakt&"<br>")
'title=RemoveHTML(aa(i))
'response.Write("title:"&title)
für n=0 zu application.Contents.count
if(application.Contents(n)=KeyId) then
ifexit=true
Ende wenn
nächste
Wenn nicht, dann ifexit
application(time&i)=KeyId
'添加到数据库
'============================================== ===
set rs=server.CreateObject("adodb.recordset")
rs.open "wählen Sie Top 1 * aus der Nachrichtenreihenfolge nach ID desc aus",conn,3,3
rs.addnew
rs("NewsClass")=NewsClass
rs("Stadt")=Stadt
rs("Position")=Position
rs("HouseType")=HouseType
rs("Level")=Level
rs("Bereich")=Bereich
rs("Preis")=Preis
rs("Demostra")=Demostra
rs("ContactMan")=ContactMan
rs("Kontakt")=Kontakt
rs.update
rs.close
setze rs=nichts
Ende wenn
'============================================== =
nächste
Funktion RemoveTag(body)
Set regEx = New RegExp
regEx.Pattern = "<[a].*?</[a]>"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(body)
dim i,arr(15),ifexit
ich=0
j=0
Für jedes Spiel in Spielen
TempStr = Match.Value
TempStr=replace(TempStr,"<td>","")
TempStr=replace(TempStr,"</td>","")
TempStr=replace(TempStr,"<tr>","")
TempStr=replace(TempStr,"</tr>","")
arr(i)=TempStr
i=i+1
if(i>=15) dann
Ausgang für
Ende wenn
Nächste
Setze regEx=nichts
Übereinstimmungen festlegen =nichts
RemoveTag=arr
Endfunktion
Funktion RegexHtml(body)
dim r_arr(47),r_temp
Setze regEx2 = Neuer RegExp
regEx2.Pattern = „<a.*?</a>“
regEx2.IgnoreCase = True
regEx2.Global = True
Setze Matches2 = regEx2.Execute(body)
iii=0
Für jedes Spiel in Spielen2
r_arr(iii)=Match.Value
iii=iii+1
Nächste
RegexHtml=r_arr
setze regEx2=nichts
setze Matches2=nichts
Endfunktion
'============================================== =====
conn.close
setze conn=nichts
%>
</body>
</html>
function.asp
<%
'************************************************ *
'函数名:gotTopic
'作 用:截字符串,汉字一个算两个字符,英文算一个字符
'参 数:str ----原字符串
' strlen ----截取长度
'返回值:截取后的字符串
'************************************************ *
Funktion gotTopic(str,strlen)
wenn str="" dann
gotTopic=""
Exit-Funktion
Ende wenn
dim l,t,c,i
str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<" )
str=replace(str,"?","")
l=len(str)
t=0
für i=1 bis l
c=Abs(Asc(Mid(str,i,1)))
wenn c>255 dann
t=t+2
anders
t=t+1
Ende wenn
wenn t>=strlen dann
gotTopic=left(str,i) & „…“
Ausgang für
anders
gotTopic=str
Ende wenn
nächste
gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<" )
Endfunktion
'============================================== ========
Hinweis: RemoveHTML(strHTML)
'功能:去除HTML标记
'参数:strHTML --要去除HTML标记的字符串
'============================================== ========
Funktion RemoveHTML(strHTML)
Dim objRegExp, Match, Matches
Setze objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
'取闭合的<>
objRegExp.Pattern = "<.+?>"
'进行匹配
Set Matches = objRegExp.Execute(strHTML)
' Diese Funktion wird nicht verwendet
Für jedes Spiel in Spielen
strHtml=Replace(strHTML,Match.Value,"")
Nächste
RemoveHTML=strHTML
Setze objRegExp = Nothing
set Matches=nothing
Endfunktion
%>
conn.asp
<%
'Bei Fehler als nächstes fortfahren
set conn=server.CreateObject("adodb.connection")
con= "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath("stest.mdb")
conn.open con
sub connclose
Verbindung schließen
setze conn=nichts
Ende sub
%>
Adresse
: | 479280. |
Adresse | : |
479280 | Maximale |
Dauer | : |
24 | bis |
240 | Minuten |
| |
间 | |
房价: | 0 [租赁:元/月,买卖:万元/套] |
其他说明: | 华信商务楼3至6层小空间对外出租(0,5元/平起),本楼属纯商务办公投资使用,可用于办公写字间, 周边设施齐全、交通便利(37、80、K95在本楼前经过), 全产权、市证, 楼内设施包括水、电、暖、电梯设施齐全,有意者可电讯! |
联系Autor: | 88017966 , |
86812217 | , |
4. | August 2005, 8:28:55 Uhr, 218.98.86.175 |
, | 19 |