db_mclass.asp

打开目录ads文件夹 找到top_ads.js文件 用记事本打开后就可以看到: -------------------------------------- var head_ads_tx

<%
Class Class_DB_UG
Private Temp
Private Sub Class_Initialize()
	
End sub

Public Function GetHttpPage(url) 
on error resume next 
dim Http 
set Http=Server.createobject("Msxml2.XMLHTTP") 
Http.open "GET",url,false 
Http.send() 
if Http.readystate<>4 then exit function
if err.number=0 then
if Http.status=200 then
getHTTPPage=Http.responseBody
else
getHTTPPage=false
end if
else
getHTTPPage=false
err.Clear  
end if
set http=nothing
End function 
Public Function BytesToBstr(body,Cset)
if VarType(body)<>8209 then
BytesToBstr=false
else
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 If
End Function
Public Function HttpUrls(strs,http)
dim imageurl,url2,n,url1,imagea
httpurls=""
imageurl=""
if UCase(left(http,4))<>"HTTP" then
http="http://"&http
end if
url2=split(http,"/")
i=0
imageurl=""
for i=0 to 2
imageurl=imageurl&url2(i)&"/"
next
n=0	
if UCase(left(strs,4))="HTTP" then
httpurls=strs
elseif UCase(left(strs,2))="//" then
httpurls="http:"&strs
else
if UCase(left(strs,1))="/" then
url1=right(strs,len(strs)-1)
httpurls=imageurl&url1
elseif UCase(left(strs,3))="../" then
url1=Split(strs,"../")
if ubound(url2)-ubound(url1)>=3 then
strs=""
i=0
for i=0 to ubound(url2)-ubound(url1)-1
strs=strs&url2(i)&"/"
next
strs=strs&url1(ubound(url1))
httpurls=strs
else
'***
url1=Split(strs,"/")
httpurls=imageurl&url1(ubound(url1))
end if
else	
imagea=""
i=0
for i=0 to ubound(url2)-1
imagea=imagea&url2(i)&"/"
next
httpurls=imagea&strs
end if
end if
End Function
Public Function GetUrlenCodel(byval url)
Dim i,code 
geturlencodel="" 
if trim(Url)="" then exit function 
for i=1 to len(Url) 
code=Asc(mid(Url,i,1)) 
if code<0 Then code = code + 65536 
If code>255 Then 
geturlencodel=geturlencodel&"%"&Left(Hex(Code),2)&"%"&Right(Hex(Code),2) 
else 
geturlencodel=geturlencodel&mid(Url,i,1) 
end if 
next 
End Function
Public Function BoldWord(strContent,word,words)
BoldWord=Replace(strContent,word,words)
End Function
Public Function CreateDIR(ByVal LocalPath)
On Error Resume Next
LocalPath=server.MapPath(LocalPath)
LocalPath = Replace(LocalPath, "\", "/")
Set FileObject = server.CreateObject("Scripting.FileSystemObject")
patharr = Split(LocalPath, "/")
path_level = UBound(patharr)
For I = 0 To path_level
If I = 0 Then pathtmp = patharr(0) & "/" Else pathtmp = pathtmp & patharr(I) & "/"
cpath = Left(pathtmp, len(pathtmp) - 1)
If Not FileObject.FolderExists(cpath) Then FileObject.CreateFolder cpath
Next
Set FileObject = Nothing
If Err.Number <> 0 Then
CreateDIR = False
Err.Clear
Else
CreateDIR = True
End If
End Function
Public function Save2Local(from,tofile)
on error resume next
dim geturl,objStream,imgs
geturl=trim(from)
imgs=getHTTPPage(geturl)
if VarType(imgs)<>8209 then
Save2Local=false
else
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type =1
objStream.Open
objstream.write imgs
objstream.SaveToFile tofile,2
objstream.Close()
set objstream=nothing
Save2Local=true
if err.number<>0 then 
err.Clear
Save2Local=false
deletefiles(tofile)
end if 
end if
end function
Public function deletefiles(path) 
on error resume next 
Set fs=Server.CreateObject("Scripting.FileSystemObject") 
if fs.FileExists(path) then 
fs.DeleteFile path,True 
end if 
Set fs=nothing 
if Err.number<>0 then Response.Write Err.number 
end function 
Public Function GenerateRandomFileName(ByVal szFilename) 
Randomize
ranNum = Int(90000 * Rnd) + 10000
If Month(Now) < 10 Then c_month = "0" & Month(Now) Else c_month = Month(Now)
If Day(Now) < 10 Then c_day = "0" & Day(Now) Else c_day = Day(Now)
If Hour(Now) < 10 Then c_hour = "0" & Hour(Now) Else c_hour = Hour(Now)
If Minute(Now) < 10 Then c_minute = "0" & Minute(Now) Else c_minute = Minute(Now)
If Second(Now) < 10 Then c_second = "0" & Second(Now) Else c_second = Minute(Now)
fileExt_a = Split(szFilename, ".")
FileExt = LCase(fileExt_a(UBound(fileExt_a)))
GenerateRandomFileName = Year(Now) & c_month & c_day & c_hour & c_minute & c_second & "_" & ranNum & "." & FileExt
End Function
Public Function stripHTML(strHTML,ben,und)
dim SearchFile,SearchFile1,pos1,pos2
SearchFile = InStrB(1, strHTML, ben, vbBinaryCompare) > 0
SearchFile1 = InStrB(1,strHTML, und, vbBinaryCompare) > 0
If SearchFile and  SearchFile1 Then
pos1 = InStrB(1, strHTML, ben, vbBinaryCompare) 
pos2 = InStrB(pos1, strHTML, und, vbBinaryCompare)  
stripHTML = MidB( strHTML, pos1 ,pos2-pos1+lenB(und))
else
stripHTML=false
end if
End Function
Public Function SeparateHTML(strHTML,ben,und)
dim SearchFile,SearchFile1,pos1,pos2
SearchFile = InStrB(1, strHTML, ben, vbBinaryCompare) > 0
SearchFile1 = InStrB(1,strHTML, und, vbBinaryCompare) > 0
If SearchFile and  SearchFile1 Then
pos1 = InStrB(1, strHTML, ben, vbBinaryCompare) 
pos2 = InStrB(pos1+lenB(ben), strHTML, und, vbBinaryCompare)
SeparateHTML = MidB(strHTML,pos1+lenB(ben),pos2-pos1-lenB(ben)) 
else
SeparateHTML =false
end if
End Function
Public Function Manhunt(webstr,Label1,Label2,IgnoreCase,Global,Include,Stir)
Label1=myConvert(Label1)
Label2=myConvert(Label2)
dim webstr2
webstr2=myConvert(webstr)
dim objregexp,matches,match,str
Set objRegExp = New Regexp 
With objRegExp
.IgnoreCase = IgnoreCase 
.Global = Global
.Pattern = "("&Label1&").+?("&Label2&")"
Set Matches =.Execute(webstr2) 
For Each Match in Matches 
str=str&Match.Value&"$url$"
Next 
set Matches=nothing
if not Include then
.Pattern = "("&Label1&")"
str=.replace(str,"")
.Pattern = "("&Label2&")"
str=.replace(str,"")
end if
if Stir then
str=replace(str,"""","")
str=replace(str,"'","")
end if
if not Global then
str=replace(str,"$url$","")
end if
end with
set objRegExp=nothing
if str="" then
Manhunt=false
else
Manhunt=str
Manhunt=myConvert_t(Manhunt)
end if
End Function
Public Function RemoveHTML(fString)
dim objRegExp
set objRegExp = New RegExp	
objRegExp.Global = True
objRegExp.IgnoreCase = True
if not isnull(fString) then
objRegExp.Pattern = "<(.[^>]*)>"
fString = objRegExp.Replace(fString,"")
RemoveHTML = fString
end if
set objRegExp=nothing
end function
Public Function Cen(content)
Cen=content
if content <> "" then
Cen=replace(Cen,chr(13),"<br>")
Cen=replace(Cen,chr(32),"&nbsp;")
end if
End function
Function myConvert_t(val)
myConvert_t=replace(val,"§§","$")
myConvert_t=replace(myConvert_t,"§（","(")
myConvert_t=replace(myConvert_t,"§）",")")
myConvert_t=replace(myConvert_t,"§※","*")
myConvert_t=replace(myConvert_t,"§＋","+")
myConvert_t=replace(myConvert_t,"§·",".")
myConvert_t=replace(myConvert_t,"§［","[")
myConvert_t=replace(myConvert_t,"§？","?")
myConvert_t=replace(myConvert_t,"§＼","\")
myConvert_t=replace(myConvert_t,"§｛","{")
myConvert_t=replace(myConvert_t,"§｜","|")
End Function
Function myConvert(val)
myConvert=replace(val,"$","§§")
myConvert=replace(myConvert,"(","§（")
myConvert=replace(myConvert,")","§）")
myConvert=replace(myConvert,"*","§※")
myConvert=replace(myConvert,"+","§＋")
myConvert=replace(myConvert,".","§·")
myConvert=replace(myConvert,"[","§［")
myConvert=replace(myConvert,"?","§？")
myConvert=replace(myConvert,"\","§＼")
myConvert=replace(myConvert,"{","§｛")
myConvert=replace(myConvert,"|","§｜")
End Function

Function Convert(val)
Convert=replace(val,"$","\$")
Convert=replace(Convert,"(","\(")
Convert=replace(Convert,")","\)")
Convert=replace(Convert,"*","\*")
Convert=replace(Convert,"+","\+")
Convert=replace(Convert,".","\.")
Convert=replace(Convert,"[","\[")
Convert=replace(Convert,"?","\?")
Convert=replace(Convert,"\","\\")
Convert=replace(Convert,"*","\*")
Convert=replace(Convert,"{","\{")
Convert=replace(Convert,"|","\|")
End Function

End Class
dim Cls
Set Cls = New Class_DB_UG
%>