希网邮件列表小偷程序

最新推荐文章于 2023-03-26 14:03:16 发布

anwell

最新推荐文章于 2023-03-26 14:03:16 发布

阅读量1k

点赞数

分类专栏： ASP 文章标签： function url action 脚本 qq c

本文链接：https://blog.youkuaiyun.com/anwell/article/details/560005

版权

ASP 专栏收录该内容

27 篇文章

订阅专栏

清风发布于： http://blog.youkuaiyun.com/anwell/archive/2005/12/23/560005.aspx

转载请注明出处，谢谢！

偶有闲瑕，做了个希网邮件列表小偷程序，郁闷的是希网的图片调用不出来：（，发出来与大家交流。

<%'by 清风 QQ: 97090444 MSN:anwellsz@msn.com 转载请注明出处，欢迎交流！
On Error Resume Next　　'忽略错误
Server.ScriptTimeOut=9999999   '设置脚本超时时间
Dim ListName
ListName = "workszptt"     '邮件列表名称，可以换成你在希网上的邮件列表名称
select case request("action")
case "view"
  show
case else
  showlist
end Select
Function showlist '显示具体条目
dim lsstart,lsend,lsstr,lstemp
lsstr=getHTTPPage("http://www.cn99.com/cgi-bin/get_lsts?listname="&ListName)
lsstart=instr(lsstr,"【下面是您要查询的列表")
lsend = instr(lsstr,"<BR></p>")
lstemp=mid(lsstr,lsstart,lsend-lsstart)
lstemp = Replace(lstemp,"catalog?","http://www.cn99.com/cgi-bin/catalog?")
lstemp = Replace(lstemp,"getmsg?listname="&ListName&"&id=","qikan.asp?action=view&id=")
lstemp = Replace(Replace(lstemp,"<TR><TD colspan=""6""> </TD></TR>",""),"#FFE0C0","#CCCCCC")
lstemp = Replace(lstemp,"FFF8F0","#F2F2F2")
response.write lstemp
end Function
Function show '显示详细信息
dim lsstr
lsstr=getHTTPPage("http://www.cn99.com/cgi-bin/getmsg/body?listname="&ListName&"&id="&request("id"))
lsstart = InStr(lsstr,"<BODY bgColor=#ffffff leftMargin=6 topMargin=4>")+47
lsend = InStr(lsstr,"个订户")+3
lstemp = Mid(lsstr,lsstart,lsend-lsstart)
lstemp = Replace(lstemp,"/cgi-bin/getmsg/rel?listname="&ListName&"&id=","http://www.cn99.com/cgi-bin/getmsg/rel?listname="&ListName&"&id=")
Response.write lstemp
end function
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
getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
set http=nothing
End function
Function PostHTTPPage(url,strForm)
dim http
set http=Server.createobject("Microsoft.XMLHTTP")
Http.open "POST",url,false
http.setRequestHeader "Content-Length",len(strForm)
    http.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
Http.send(strForm)
if Http.readystate<>4 then
  exit function
end if
PostHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
set http=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%>