|
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%> ywuLinux联盟
<!-- #include file="conn.ASP" --> ywuLinux联盟
<!-- #include file="inc/function.asp" --> ywuLinux联盟
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" ywuLinux联盟
"http://www.w3.org/TR/html4/loose.dtd"> ywuLinux联盟
<html> ywuLinux联盟
<head> ywuLinux联盟
<title>Untitled Document</title> ywuLinux联盟
<meta http-equiv="Content-Type" content="text/html; charset=gb2312"> ywuLinux联盟
<meta http-equiv="refresh" content="300;URL=steal_house.asp"> ywuLinux联盟
</head> ywuLinux联盟
<body> ywuLinux联盟
<% ywuLinux联盟
on error resume next ywuLinux联盟
' ywuLinux联盟
Server.ScriptTimeout = 999999 ywuLinux联盟
'======================================================== ywuLinux联盟
'字符编码函数 ywuLinux联盟
'==================================================== ywuLinux联盟
Function BytesToBstr(body,code) ywuLinux联盟
dim objstream ywuLinux联盟
set objstream = Server.CreateObject("adodb.stream") ywuLinux联盟
objstream.Type = 1 ywuLinux联盟
objstream.Mode =3 ywuLinux联盟
objstream.Open ywuLinux联盟
objstream.Write body ywuLinux联盟
objstream.Position = 0 ywuLinux联盟
objstream.Type = 2 ywuLinux联盟
objstream.Charset =code ywuLinux联盟
BytesToBstr = objstream.ReadText ywuLinux联盟
objstream.Close ywuLinux联盟
set objstream = nothing ywuLinux联盟
End Function ywuLinux联盟
'取行字符串在另一字符串中的出现位置 ywuLinux联盟
Function Newstring(wstr,strng) ywuLinux联盟
Newstring=Instr(lcase(wstr),lcase(strng)) ywuLinux联盟
if Newstring<=0 then Newstring=Len(wstr) ywuLinux联盟
End Function ywuLinux联盟
'替换字符串函数 ywuLinux联盟
function ReplaceStr(ori,str1,str2) ywuLinux联盟
ReplaceStr=replace(ori,str1,str2) ywuLinux联盟
end function ywuLinux联盟
'==================================================== ywuLinux联盟
function ReadXML(url,code,start,ends) ywuLinux联盟
set oSend=createobject("Microsoft.XMLHTTP") ywuLinux联盟
SourceCode = oSend.open ("GET",url,false) ywuLinux联盟
oSend.send() ywuLinux联盟
ReadXml=BytesToBstr(oSend.responseBody,code ) ywuLinux联盟
start=Instr(ReadXml,start) ywuLinux联盟
ReadXml=mid(ReadXml,start) ywuLinux联盟
ends=Instr(ReadXml,ends) ywuLinux联盟
ReadXml=left(ReadXml,ends-1) ywuLinux联盟
end function ywuLinux联盟
function SubStr(body,start,ends) ywuLinux联盟
start=Instr(body,start) ywuLinux联盟
SubStr=mid(body,start+len(start)+1) ywuLinux联盟
ends=Instr(SubStr,ends) ywuLinux联盟
SubStr=left(SubStr,ends-1) ywuLinux联盟
end function ywuLinux联盟
dim getcont,NewsContent ywuLinux联盟
dim url,title ywuLinux联盟
url="http://www.***.com"'新闻网址 ywuLinux联盟
getcont=ReadXml(url,"gb2312","<table class=k2 border=""0""","</table>") ywuLinux联盟
getcont=RegexHtml(getcont) ywuLinux联盟
dim KeyId,NewsClass,City,Position,HouseType,Level,Area,Price,Demostra ywuLinux联盟
dim ContactMan,Contact ywuLinux联盟
for i=2 to ubound(getcont) ywuLinux联盟
response.Write(getcont(i)&"__<br>") ywuLinux联盟
ywuLinux联盟
tempLink=mid(getcont(i),instr(getcont(i),"href=""")+6,instr(getcont(i),""" ywuLinux联盟
onClick")-10) ywuLinux联盟
tempLink=replace(tempLink,"../","") ywuLinux联盟
ywuLinux联盟
response.Write(i&":"&tempLink&"<br>") ywuLinux联盟
NewsContent=ReadXml(tempLink,"gb2312","<td valign=""bottom"" ywuLinux联盟
width=""400"">","<hr width=""760"" ywuLinux联盟
noshade size=""1"" color=""#808080""> ywuLinux联盟
") ywuLinux联盟
NewsContent=RemoveHtml(NewsContent) ywuLinux联盟
NewsContent=replace(NewsContent,VbCrLf,"") ywuLinux联盟
NewsContent=replace(NewsContent,vbNewLine,"") ywuLinux联盟
NewsContent=replace(NewsContent," ","") ywuLinux联盟
NewsContent=replace(NewsContent," ","") ywuLinux联盟
NewsContent=replace(NewsContent," ","") ywuLinux联盟
NewsContent=replace(NewsContent,"\n","") ywuLinux联盟
NewsContent=replace(NewsContent,chr(10),"") ywuLinux联盟
NewsContent=replace(NewsContent,chr(13),"") ywuLinux联盟
'===============get Content======================= ywuLinux联盟
response.Write(NewsContent) ywuLinux联盟
KeyId=SubStr(NewsContent,"列号：","信息类别：") ywuLinux联盟
NewsClass=SubStr(NewsContent,"类别：","所在城市：") ywuLinux联盟
City=SubStr(NewsContent,"城市：","房屋具体位置：") ywuLinux联盟
Position=SubStr(NewsContent,"位置：","房屋类型：") ywuLinux联盟
HouseType=SubStr(NewsContent,"类型：","楼层：") ywuLinux联盟
Level=SubStr(NewsContent,"楼层：","使用面积：") ywuLinux联盟
Area=SubStr(NewsContent,"面积：","房价：") ywuLinux联盟
Price=SubStr(NewsContent,"房价：","其他说明：") ywuLinux联盟
Demostra=SubStr(NewsContent,"说明：","联系人：") ywuLinux联盟
ContactMan=SubStr(NewsContent,"联系人：","联系方式：") ywuLinux联盟
Contact=SubStr(NewsContent,"联系方式：","信息来源：") ywuLinux联盟
response.Write("总序列号:"&KeyId&"<br>") ywuLinux联盟
response.Write("信息类别:"&NewsClass&"<br>") ywuLinux联盟
response.Write("所在城市:"&City&"<br>") ywuLinux联盟
response.Write("房屋具体位置:"&Position&"<br>") ywuLinux联盟
response.Write("房屋类型:"&HouseType&"<br>") ywuLinux联盟
response.Write("楼层:"&Level&"<br>") ywuLinux联盟
response.Write("使用面积:"&Area&"<br>") ywuLinux联盟
response.Write("房价:"&Price&"<br>") ywuLinux联盟
response.Write("其他说明:"&Demostra&"<br>") ywuLinux联盟
response.Write("联系人:"&ContactMan&"<br>") ywuLinux联盟
response.Write("联系方式:"&Contact&"<br>") ywuLinux联盟
'title=RemoveHTML(aa(i)) ywuLinux联盟
'response.Write("title:"&title) ywuLinux联盟
for n=0 to application.Contents.count ywuLinux联盟
if(application.Contents(n)=KeyId) then ywuLinux联盟
ifexit=true ywuLinux联盟
end if ywuLinux联盟
next ywuLinux联盟
if not ifexit then ywuLinux联盟
application(time&i)=KeyId ywuLinux联盟
'添加到数据库 ywuLinux联盟
'==================================================== ywuLinux联盟
set rs=server.CreateObject("adodb.recordset") ywuLinux联盟
rs.open "select top 1 * from news order by id desc",conn,3,3 ywuLinux联盟
rs.addnew ywuLinux联盟
rs("NewsClass")=NewsClass ywuLinux联盟
rs("City")=City ywuLinux联盟
rs("Position")=Position ywuLinux联盟
rs("HouseType")=HouseType ywuLinux联盟
rs("Level")=Level ywuLinux联盟
rs("Area")=Area ywuLinux联盟
rs("Price")=Price ywuLinux联盟
rs("Demostra")=Demostra ywuLinux联盟
rs("ContactMan")=ContactMan ywuLinux联盟
rs("Contact")=Contact ywuLinux联盟
rs.update ywuLinux联盟
rs.close ywuLinux联盟
set rs=nothing ywuLinux联盟
end if ywuLinux联盟
'================================================== ywuLinux联盟
ywuLinux联盟
next ywuLinux联盟
function RemoveTag(body) ywuLinux联盟
Set regEx = New RegExp ywuLinux联盟
regEx.Pattern = "<[a].*?<\/[a]>" ywuLinux联盟
regEx.IgnoreCase = True ywuLinux联盟
regEx.Global = True ywuLinux联盟
Set Matches = regEx.Execute(body) ywuLinux联盟
dim i,arr(15),ifexit ywuLinux联盟
i=0 ywuLinux联盟
j=0 ywuLinux联盟
For Each Match in Matches ywuLinux联盟
TempStr = Match.Value ywuLinux联盟
TempStr=replace(TempStr,"<td>","") ywuLinux联盟
TempStr=replace(TempStr,"</td>","") ywuLinux联盟
TempStr=replace(TempStr,"<tr>","") ywuLinux联盟
TempStr=replace(TempStr,"</tr>","") ywuLinux联盟
arr(i)=TempStr ywuLinux联盟
i=i+1 ywuLinux联盟
if(i>=15) then ywuLinux联盟
exit for ywuLinux联盟
end if ywuLinux联盟
Next ywuLinux联盟
Set regEx=nothing ywuLinux联盟
Set Matches =nothing ywuLinux联盟
RemoveTag=arr ywuLinux联盟
ywuLinux联盟
end function ywuLinux联盟
function RegexHtml(body) ywuLinux联盟
dim r_arr(47),r_temp ywuLinux联盟
Set regEx2 = New RegExp ywuLinux联盟
regEx2.Pattern ="<a.*?<\/a>" ywuLinux联盟
regEx2.IgnoreCase = True ywuLinux联盟
regEx2.Global = True ywuLinux联盟
Set Matches2 = regEx2.Execute(body) ywuLinux联盟
iii=0 ywuLinux联盟
For Each Match in Matches2 ywuLinux联盟
ywuLinux联盟
r_arr(iii)=Match.Value ywuLinux联盟
ywuLinux联盟
iii=iii+1 ywuLinux联盟
Next ywuLinux联盟
RegexHtml=r_arr ywuLinux联盟
set regEx2=nothing ywuLinux联盟
set Matches2=nothing ywuLinux联盟
end function ywuLinux联盟
'====================================================== ywuLinux联盟
conn.close ywuLinux联盟
set conn=nothing ywuLinux联盟
%> ywuLinux联盟
</body> ywuLinux联盟
</html> ywuLinux联盟
function.ASP ywuLinux联盟
ywuLinux联盟
ywuLinux联盟
ywuLinux联盟
ywuLinux联盟
ywuLinux联盟
<% ywuLinux联盟
'************************************************** ywuLinux联盟
'函数名：gotTopic ywuLinux联盟
'作 用：截字符串，汉字一个算两个字符，英文算一个字符 ywuLinux联盟
'参 数：str ----原字符串 ywuLinux联盟
' strlen ----截取长度 ywuLinux联盟
'返回值：截取后的字符串 ywuLinux联盟
'************************************************** ywuLinux联盟
function gotTopic(str,strlen) ywuLinux联盟
if str="" then ywuLinux联盟
gotTopic="" ywuLinux联盟
exit function ywuLinux联盟
end if ywuLinux联盟
dim l,t,c, i ywuLinux联盟
str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<") ywuLinux联盟
str=replace(str,"?","") ywuLinux联盟
l=len(str) ywuLinux联盟
t=0 ywuLinux联盟
for i=1 to l ywuLinux联盟
c=Abs(Asc(Mid(str,i,1))) ywuLinux联盟
if c>255 then ywuLinux联盟
t=t+2 ywuLinux联盟
else ywuLinux联盟
t=t+1 ywuLinux联盟
end if ywuLinux联盟
if t>=strlen then ywuLinux联盟
gotTopic=left(str,i) & "…" ywuLinux联盟
exit for ywuLinux联盟
else ywuLinux联盟
gotTopic=str ywuLinux联盟
end if ywuLinux联盟
next ywuLinux联盟
gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<") ywuLinux联盟
end function ywuLinux联盟
'========================================================= ywuLinux联盟
'函数：RemoveHTML(strHTML) ywuLinux联盟
'功能：去除HTML标记 ywuLinux联盟
'参数：strHTML --要去除HTML标记的字符串 ywuLinux联盟
'========================================================= ywuLinux联盟
Function RemoveHTML(strHTML) ywuLinux联盟
Dim objRegExp, Match, Matches ywuLinux联盟
Set objRegExp = New Regexp ywuLinux联盟
objRegExp.IgnoreCase = True ywuLinux联盟
objRegExp.Global = True ywuLinux联盟
'取闭合的<> ywuLinux联盟
objRegExp.Pattern = "<.+?>" ywuLinux联盟
'进行匹配 ywuLinux联盟
Set Matches = objRegExp.Execute(strHTML) ywuLinux联盟
' 遍历匹配集合，并替换掉匹配的项目 ywuLinux联盟
For Each Match in Matches ywuLinux联盟
strHtml=Replace(strHTML,Match.Value,"") ywuLinux联盟
Next ywuLinux联盟
RemoveHTML=strHTML ywuLinux联盟
Set objRegExp = Nothing ywuLinux联盟
set Matches=nothing ywuLinux联盟
End Function ywuLinux联盟
%> ywuLinux联盟
ywuLinux联盟
ywuLinux联盟
ywuLinux联盟
conn.asp ywuLinux联盟
ywuLinux联盟
<% ywuLinux联盟
'on error resume next ywuLinux联盟
set conn=server.CreateObject("adodb.connection") ywuLinux联盟
con= "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath("stest.mdb") ywuLinux联盟
ywuLinux联盟
conn.open con ywuLinux联盟
sub connclose ywuLinux联盟
conn.close ywuLinux联盟
set conn=nothing ywuLinux联盟
end sub ywuLinux联盟
%> ywuLinux联盟
Linux联盟收集整理 ,转贴请标明原始链接,如有任何疑问欢迎来本站Linux论坛讨论 |
|
