我的ASP小偷类

<%
option explicit

dim cls
set cls = new cls_class

class cls_class
private xmlhttp,xstrem,xreg
private s_cookie

private sub class_initialize
set xmlhttp = server.createobject("Msxml2.ServerXMLHTTP")
set xreg = new regexp
set xstrem = server.createobject("adodb.stream")
end sub

private sub class_terminate
set xmlhttp = nothing : set xreg = nothing : set xstrem = nothing
end sub

public property let cookie(scookie)
s_cookie = scookie
end property

public property get bytes
bytes = "$false$"
end property

public property get version
version = "百乐小说(www.86086.net)"
end property

public function de(bystr)
response.write bystr
end function

public function deurl(byurl)
deurl = server.UrlEnCode(byurl)
end function

public function result(byval surl,byval scharset)
if isnull(surl) then result = true : exit function
on error resume next
with xmlhttp
.setTimeouts 5000,5000,5000,60000
.open "GET",surl,False
.SetRequestHeader "Cookie", ";"
.send()
if err.number <> 0 or .readystate <> 4 or .status <> 200 then
result = err.description : err.clear
else
result = bytestobstr(.responsebody,scharset)
end if
end with
end function

public function bytestobstr(byval sbody,byval scharset)
with xstrem
.type = 1
.mode = 3
.open
.write sbody
.position = 0
.type = 2
.charset = scharset
bytestobstr = .readtext
.close
end with
end function

public function cutstr(byval vconstr,byval vstart,byval vover,byval vl,byval vr)
dim strtmp,start,over
strtmp = lcase(vconstr) : vstart = lcase(vstart) : vover = lcase(vover)
if len(vconstr) < 1 or len(vstart) < 1 or len(vover) < 1 then cutstr = bytes : exit function
if vconstr = bytes then cutstr = bytes : exit function
if isnull(vconstr) or isnull(vstart) or isnull(vover) then cutstr = bytes : exit function
start = instrb(1,strtmp,vstart,vbbinarycompare)
if start <= 0 then
cutstr = bytes : exit function
else
if vl = false then start = start + lenb(vstart)
end if
over = instrb(start,strtmp,vover,vbbinarycompare)
if over <= 0 or over <= start then
cutstr = bytes : exit function
else
if vr = true then over = over + lenb(vover)
end if
cutstr = midb(vconstr,start,over-start)
end function

public function load(byval surl,byval scharset,byval skey,byval stime)
dim rval,tval,stemp
skey = lcase(s_cookie & chr(95) & skey) : stime = clng(stime)
rval = application(skey)
tval = application(skey &"_time")
if tval = "" then tval = dateadd("h",stime,now())
stemp = datediff("h",now(),tval)
if stemp > 0 and rval <> "" then
load = rval
else
load = result(surl,scharset)
if load <> bytes then
application.lock : application(skey) = load : application(skey &"_time") = dateadd("h",stime,now()) : application.unlock
else
response.write err.description : err.clear : response.end
end if
end if
end function

public function uncode(byval word,byval snum)
word = replace(word,"&nbsp;","")
if isnull(word) then exit function
xreg.global = true : xreg.ignorecase = true : xreg.pattern = "<.*?>" : word = xreg.replace(word,"")
if snum <> 0 then
if len(word) > snum then word = left(word,snum)+".."
end if
xreg.pattern="\r\n\s*" : word = xreg.replace(word,"")
uncode = replace(replace(word,chr(10),""),chr(32),"")
end function

public function conver(byval svalue,byval spatrn,byval snewstr)
if svalue <> "" then
xreg.ignorecase = true : xreg.global = true : xreg.pattern = spatrn
conver = xreg.replace(svalue,snewstr)
end if
end function
end class
%>

转载于:https://www.cnblogs.com/mywap/archive/2011/11/13/2247442.html