一个asp采集程序

<%
  if request.QueryString="" then
      url="http://www.hbcz.gov.cn:7001/XZQHQueryWAR/xxcx/loca_zjxx1.jsp?page=1&table=cz_bzhqincjs&qhstr=D420684&class_fovo=&class_ssort=&D3=&D4=&T1=&T2="
  else
      url="http://www.hbcz.gov.cn:7001/XZQHQueryWAR/xxcx/loca_zjxx1.jsp?"&request.QueryString&"&"&request.Form
  end if
  response.Write request.Form
  'response.End()
  str=getHTTPPage(url)
  str=replace(str,"loca_zjxx1.jsp","index.asp")
  str=replace(str,"<link href=""images/css.css"" rel=stylesheet type=text/css >","<link href=""http://www.hbcz.gov.cn:7001/XZQHQueryWAR/xxcx/images/css.css"" rel=stylesheet type=text/css >")
  response.write str
%>
<%
Function getHTTPPage(url) 
    On Error Resume Next
    dim http 
    set http=Server.createobject("Microsoft.XMLHTTP") 
    Http.open "GET",url,false 
    Http.send() 
    if Http.readystate<>4 then
        exit function 
    end if 
    getHTTPPage=BytesToBstr(Http.responseBody,"GB2312")
    set http=nothing
    If Err.number<>0 then 
        Response.Write "<p align='center'><font color='red'><b>服务器获取文件内容出错</b></font></p>" 
        Err.Clear
    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
'Download by http://www.codefans.net
'截取字符串,1.包括起始和终止字符，2.不包括
Function strCut(strContent,StartStr,EndStr,CutType)
    Dim strHtml,S1,S2
    strHtml = strContent
    On Error Resume Next
    Select Case CutType
    Case 1
        S1 = InStr(strHtml,StartStr)
        S2 = InStr(S1,strHtml,EndStr)+Len(EndStr)
    Case 2
        S1 = InStr(strHtml,StartStr)+Len(StartStr)
        S2 = InStr(S1,strHtml,EndStr)
    End Select
    If Err Then
        strCute = "<p align='center'>没有找到需要的内容。</p>"
        Err.Clear
        Exit Function
    Else
        strCut = Mid(strHtml,S1,S2-S1)
    End If
End Function
%>

 

转载于:https://www.cnblogs.com/changbin/p/4162195.html