ASP广告作弊程序代码

针对一流广告的，当时效果好的是没法说！刚翻硬盘翻出来，共享出来！
其实其他的广告，只要是点击的，原理是一样的，只是广告商的防作弊手法不一样！
使用方法么？使用过的人都知道了！
<%
''链接部分
Dim url,iurl,isNewDay
url = "[url]http://vip.ads99.net/banner468-0-b.php?userid=xxxxxx&size=468x60[/url]"
iurl = "[url]http://vip.ads99.net/click.php?userid=xxxxxx[/url]"
ClickNum = 80 ''每天点击数
vIP = Request.ServerVariables("Remote_Addr")
CacheName = "xxxxxx" ''缓存前缀，可以修改
DayCacheName = CacheName & "lastDay"
LastIPCacheName = CacheName & "LastIp"
ClickNumCacheName = CacheName & "ClickNum"
''防止查看本文件
ComeUrl = lcase(request.ServerVariables("HTTP_REFERER"))
if ComeUrl="" then
response.write "<br><p align=center><font color=''red''>对不起，为了系统安全，不允许直接输入地址访问本文件。</font></p>"
response.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)
'' 是否新的一天
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,"$contentquot;)
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(""<script src="&linkurl&"></script>"");"
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
objstre