ASP广告作弊程序代码

　　ClickNumCacheName = CacheName & "ClickNum"

　　'防止查看本文件

　　ComeUrl = lcase(request.ServerVariables("HTTP_REFERER"))

　　if ComeUrl="" then

　　response.write "

　　"

　　mkoei.comresponse.End

　　End If

　　'第一次运行赋值

　　if isempty(Application(DayCacheName)) then Application(DayCacheName)=Date()

　　if isempty(Application(LastIPCacheName)) then Application(LastIPCacheName)="#202.196.176.222#"

　　if isempty(Application(ClickNumCacheName)) then Application(ClickNumCacheName)=0

　　'Application(LastIPCacheName) = "#202.196.176.222#"

　　'response.write Application(DayCacheName)

　　'response.write Application(ClickNumCacheName)lposm.com

　　' 是否新的一天

　　if DateValue(Application(DayCacheName)) < DateValue(now()) then

　　Application(DayCacheName) = Date()

　　Application(LastIPCacheName) = "#202.196.176.222#"

　　Application(ClickNumCacheName) = 0

　　End If

　　If Application(ClickNumCacheName)>=ClickNum Then response.End

　　'是否刷新

　　if instr(Application(LastIPCacheName),"#" & vIP & "#") then

　　response.End

　　Else

　　' 更新最近需要防刷的IP

　　Application.Lock

　　Application(LastIPCacheName)=Application(LastIPCacheName) & "#" & vIP & "#"

　　Application.UnLock

　　Dim J,UrlNum,html

　　html= getHTTPPage(url)

　　urls=RegExpExecute(html)

　　links = Split(urls,"$$$")

　　For i = 0 To UBound(links)

　　If InStr(links(i),iurl)>0 Then

　　linkurl = links(i)

　　End If

　　Next

　　j = 3

　　Randomize

　　UrlNum = Int((20 * Rnd) + 1)

　　If UrlNum Mod j = 0 Then

　　response.write "document.write("""");"

　　Application.Lock

　　Application(ClickNumCacheName)=Application(ClickNumCacheName)+1

　　Application.UnLock

　　End If

　　End If

　　'获取链接函数

　　Function getHTTPPage(url)

　　Dim Http

　　Set Http=server.createobject("MSXML2.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 err.Clear

　　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

　　'提取链接函数

　　Function RegExpExecute(strng)

　　Dim regEx, Match, Matches

　　Set regEx = New RegExp