Asp利用XmlHttp采集网页数据 - ASP技术论坛

问题点数：0 回复次数：0

Asp利用XmlHttp采集网页数据

<%
On Error Resume Next
Server.ScriptTimeOut=300
function getHTTPPage(Path)
        t = GetBody(Path)
        getHTTPPage=BytesToBstr(t,"GB2312")
end function

function GetBody(url)
        'on error resume next
        Set Retrieval = CreateObject("Microsoft.XMLHTTP")
        With Retrieval
        .Open "Get", url, False, "", ""
        .Send
        GetBody = .ResponseBody
        end With
        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

'------------------------------------------------------------
'获取源字符串中以某字符串开始并且以某字符串结束，中间的那段字符串
'SourceStr : 源字符串
'BeginStr : 开始字符串
'EndStr : 结束字符串
'WithB : 是否包含开始字符串(1代表包含0代表不包含)
'WithE : 是否包含结束字符串(1代表包含0代表不包含)
'说明：开始字符串一定要保证是唯一字符串，否则会是在源字符串中第一次出现的那个位置
'-----------------------------------------------------------------------------
function GetMidWith(byval SourceStr,BeginStr,EndStr,WithB,WithE)
dim bIndex
bIndex = instr(SourceStr,BeginStr)
if bIndex <= 0 then GetMidWith = "":exit function

SourceStr = mid(SourceStr,bIndex + len(BeginStr))'不包含开始字符串

bIndex = instr(SourceStr,EndStr)
if bIndex <= 0 then GetMidWith = SourceStr:exit function

if WithE = 1 then
  GetMidWith = mid(SourceStr,1,bIndex + len(EndStr) - 1)'包含结束字符串
else
  GetMidWith = mid(SourceStr,1,bIndex-1)'不包含结束字符串
end if

if WithB = 1 then GetMidWith = BeginStr & GetMidWith'包含开始字符串
end function

'------------------------------------------------------------
'获取源字符串中以某字符串开始并且以某字符串结束，中间的那段字符串
'SourceStr : 源字符串
'BeginStr : 开始字符串
'EndStr : 结束字符串
'WithB : 是否包含开始字符串(1代表包含0代表不包含)
'WithE : 是否包含结束字符串(1代表包含0代表不包含)
'说明：开始字符串与结束字符串一定要保证是唯一字符串
'-----------------------------------------------------------------------------
function GetMid(byval SourceStr,BeginStr,EndStr,WithB,WithE)
dim bIndex
dim eIndex

bIndex = instr(SourceStr,BeginStr)
eIndex = instr(SourceStr,EndStr)
if bIndex <= 0 or eIndex <= 0 or eIndex - bIndex<=0 then GetMid = "":exit function

if WithB = 1 then
  if WithE = 1 then
   GetMid = mid(SourceStr,bIndex,eIndex + len(EndStr) - bIndex)'包含开始字符串包含结束字符串
  else
   GetMid = mid(SourceStr,bIndex,eIndex - bIndex)'包含开始字符串不包含结束字符串
  end if
else
  if WithE = 1 then
   GetMid = mid(SourceStr,bIndex + len(BeginStr),eIndex + len(EndStr) - bIndex - len(BeginStr))'不包含开始字符串包含结束字符串
  else
   GetMid = mid(SourceStr,bIndex + len(BeginStr),eIndex - len(BeginStr) - bIndex)'不包含开始字符串不包含结束字符串
  end if
end if
end function
%>

<html>

<BODY bgColor=#ffffff leftMargin=0 topMargin=0 MARGINHEIGHT=0 MARGINWIDTH=0>

<%
Dim url

url="http://www.baidu.com/"
response.Write GetMidWith(getHTTPPage(url),"<input type=""submit""","</span>",1,0)
%>

</body></html>

原文：http://

搜索更多相关主题的帖子: False　