xmlhttp 抓取网页内容1

王朝asp·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

<%

On Error Resume Next

Server.ScriptTimeOut=9999999

Function getHTTPPage(Path)

t = GetBody(Path)

getHTTPPage=BytesToBstr(t,"GB2312")

End function

Function bytes2BSTR(vIn)

strReturn = ""

For j = 1 To LenB(vIn)

ThisCharCode = AscB(MidB(vIn,j,1))

If ThisCharCode < &H80 Then

strReturn = strReturn & Chr(ThisCharCode)

Else

NextCharCode = AscB(MidB(vIn,j+1,1))

strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))

j = j + 1

End If

Next

bytes2BSTR = strReturn

End Function

Function GetBody(url)

on error resume next

Set Retrieval = CreateObject("Microsoft.XMLHTTP")

Retrieval.Open "Get", url, False, "", ""

Retrieval.Send

GetBody =Retrieval.responsebody

Set Retrieval = Nothing

End Function

Function BytesToBstr(body,Cset)

dim objstream

set objstream = Server.CreateObject("adodb.stream")

objstream.Type = 1

objstream.Mode =3

objstream.Open

objstream.Write body

objstream.Position = 0

objstream.Type = 2

objstream.Charset = Cset

BytesToBstr = objstream.ReadText

objstream.Close

set objstream = nothing

End Function

Function Newstring(wstr,strng)

Newstring=Instr(lcase(wstr),lcase(strng))

if Newstring<=0 then Newstring=Len(wstr)

End Function

%>

<%

Dim wstr,str,url,start,over,city

city = Request.QueryString("id")

url="http://cn.finance.yahoo.com/q?s=USDKRW=X&d=c"

wstr=getHTTPPage(url)

start=Newstring(wstr,"最後交易")

over=Newstring(wstr,"买方出价")

body=mid(wstr,start,over-start)

start2=Instr(body,"<b>")+3

over2=Instr(body,"</b>")

body2=mid(body,start2,over2-start2)

response.write body2

%>

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航