海报  冒号  PHPLIB  IF  问号  获得  空格  2015

您所在的位置:小祥子 » 编程 » ASP » 正文

ASP截取网页函数

时间:2015-01-15 编辑:佚名 来源:互联网

使用方法 getHTTPPage(http://www.xiaoxiangzi.com) 代码如下

Function getHTTPPage(url)
    dim http
    set http=Server.createobject("Microsoft.XMLHTTP")
    Http.open "GET",url,false
    Http.send()
    if Http.readystate<>4 then
       exit function
    end if
    if (RegExpTest("utf",http.ResponseText))=1 Then
        getHTTPPage=http.ResponseText
    else
           Cset="gb2312"
           getHTTPPage=Http.ResponseText
    End if
    set http=nothing
    if err.number<>0 then err.Clear 
End function
Function RegExpTest(patrn, strng)
  Dim regEx, retVal
  Set regEx = New RegExp
  regEx.Pattern = patrn
  regEx.IgnoreCase = False
  retVal = regEx.Test(strng)
  If retVal Then
    RegExpTest = 1
  Else
    RegExpTest = 0
  End If
End Function
Function GetHtml(PageCode,startstr,overstr)
    Dim start,over
    If InStr(PageCode,startstr) > 0 And InStr(PageCode,overstr) > 0 Then   
    start=Instr(1,PageCode,startstr,vbBinaryCompare)+len(startstr)
    over=Instr(start,PageCode,overstr,vbBinaryCompare)-start
    GetHtml=Mid(PageCode,start,over)
    Else
    GetHtml =0
    End If
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

关键词:截取 网页 函数