一个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
%>
复制代码

 

posted @   襄阳老兵  阅读(763)  评论(0编辑  收藏  举报
编辑推荐:
· ASP.NET Core 模型验证消息的本地化新姿势
· 对象命名为何需要避免'-er'和'-or'后缀
· SQL Server如何跟踪自动统计信息更新?
· AI与.NET技术实操系列:使用Catalyst进行自然语言处理
· 分享一个我遇到过的“量子力学”级别的BUG。
阅读排行:
· C# 中比较实用的关键字,基础高频面试题!
· .NET 10 Preview 2 增强了 Blazor 和.NET MAUI
· 为什么AI教师难以实现
· 如何让低于1B参数的小型语言模型实现 100% 的准确率
· AI Agent爆火后,MCP协议为什么如此重要!
点击右上角即可分享
微信分享提示