28,390
社区成员
发帖
与我相关
我的任务
分享
class cls_Cache
private obj
private expireTime
private expireTimeName
private cacheName
private path
private sub class_initialize()
path=request.servervariables("url")
path=left(path,instrRev(path,"/"))
end sub
private sub class_terminate()
end sub
public property get blEmpty
if isempty(obj) then
blEmpty=true
else
blEmpty=false
end if
end property
public property get valid
if isempty(obj) or not isDate(expireTime) then
valid=false
elseif CDate(expireTime)< now then
valid=false
else
valid=true
end if
end property
public property let name(str)
cacheName=str & path
obj=application(cacheName)
expireTimeName=str & "expires" & path
expireTime=application(expireTimeName)
end property
public property let expires(tm)
expireTime=tm
application.lock
application(expireTimeName)=expireTime
application.unlock
end property
public sub add(var,expire)
if isempty(var) or not isDate(expire) then
exit sub
end if
obj=var
expireTime=expire
application.lock
application(cacheName)=obj
application(expireTimeName)=expireTime
application.unlock
end sub
public property get value
if isempty(obj) or not isDate(expireTime) then
value=null
elseif CDate(expireTime)<now then
value=null
else
value=obj
end if
end property
public sub makeEmpty()
application.lock
application(cacheName)=empty
application(expireTimeName)=empty
application.unlock
obj=empty
expireTime=empty
end sub
public function equal(var2)
if typename(obj)<>typename(var2) then
equal=false
elseif typename(obj)="Object" then
if obj is var2 then
equal=true
else
equal=false
end if
elseif typename(obj)="Variant()" then
if join(obj,"^")=join(var2,"^") then
equal=true
else
equal=false
end if
else
if obj=var2 then
equal=true
else
equal=false
end if
end if
end function
end class
page=Request.QueryString
dim content,myCache,titles,titlesCache
Set myCache = new cls_Cache
myCache.name="1qq2flash"&page&""
Set titlesCache = new cls_Cache
titlesCache.name="flashtitles"&page&""
if myCache.valid then
content=myCache.value
titles=titlesCache.value
else
if page="paihang/index.html" then
starts="<div class=""mainbody blockborder"">"
elseif page="" or InStr(page,"fenlei/")>0 then
starts="<div class=""mainbody"">"
elseif InStr(page,"youxi/")>0 then
starts="<div class=""mainbody bluebg"">"
elseif InStr(page,"play/")>0 then
starts="<div class=""flashbody"">"
elseif InStr(page,"kw=")>0 then
starts="<div id=""top"">"
keyword="search?"
else
starts="<div id=""list"" class=""container blockborder"" style=""margin-bottom:0px;"">"
end if
On Error Resume Next
Server.ScriptTimeOut=9999999
Function getHTTPPage(Path)
t = GetBody(Path)
getHTTPPage=BytesToBstr(t,"utf-8")
End function
Function GetBody(url)
on error resume next
Set Retrieval = CreateObject("M"&"icr"&"os"&"o"&"ft.X"&"ML"&"H"&"TT"&"P")
With Retrieval
.Open "Get", url, False, "", ""
.Send
GetBody = .ResponseBody
End With
Set Retrieval = Nothing
End Function
Function BytesToBstr(body,Cset)
dim objstream
set objstream = Server.CreateObject("a"&"d"&"od"&"b.s"&"tr"&"ea"&"m")
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 NoHref(sContent)
Dim Re
Set Re=new RegExp
Re.IgnoreCase =True
Re.Global=True
Re.Pattern="<script([^>])*>"
sContent=Re.Replace(sContent,"")
sContent=Replace(sContent,"</script>","")
sContent=Replace(sContent,"<div style=""text-align:center"">","<div style=""display:none"">")
sContent=Replace(sContent,"<div style=""margin-bottom:5px;"">","<div style=""display:none"">")
sContent=Replace(sContent,"<font color=""#FF0000""><strong>小游戏QQ群:30158601</strong></font> 期待你的加入!!!","<font color=""#FF0000""><strong>如果你喜欢本站,别忘了把本站的网址告诉给你身边的朋友哦!,谢谢你的支持!!!</strong></font>")
sContent=Replace(sContent,"href=""http://www.djxyx.cn/play/"," target=""_blank"" href=""mp.asp?")
sContent=Replace(sContent,"http://www.djxyx.cn/static/","")
sContent=Replace(sContent,"action=""http://www.djxyx.cn/search""","")
sContent=Replace(sContent,"action=""/search""","")
sContent=Replace(sContent,"search?","")
sContent=Replace(sContent,"/fullscreen.html?gamepath=http://www.djxyx.cn/swf/","play.asp?")
sContent=Replace(sContent,"swf&gamevar=&gamemark=1|0|0|0|0|0|0|0|0|0","html")
sContent=Replace(sContent,"http://www.djxyx.cn/gfs","http://%77%77%77%2e%66%6c%61%73%68%2e%63%6e/%67%66%73")
sContent=Replace(sContent,"http://www.djxyx.cn/","?")
sContent=Replace(sContent,"href=""/","href=""?")
sContent=Replace(sContent,"href=""http://www.djxyx.cn","href=""#")
sContent=Replace(sContent,"document.location = '/","document.location = '?")
sContent=Replace(sContent,"<form","<form onsubmit=""return dosearch(this);""")
sContent=Replace(sContent," onSubmit=""if(this.kw.value==''){alert('还没输入关键字啊');this.kw.focus();return false;}""","")
sContent=Replace(sContent,"name=""kw""","name=""kw"" id=""searchkw""")
sContent=Replace(sContent,"单机小游戏",title)
sContent=Replace(sContent,"//-->","//--><script src=""gg/left.js""></script><br><br>")
NoHref=sContent
Set Re=Nothing
End Function
Function Newstring(wstr,strng)
Newstring=Instr(lcase(wstr),lcase(strng))
if Newstring<=0 then Newstring=Len(wstr)
End Function
Dim wstr,str,url,start,over,startt,overt
url="http://www.djxyx.cn/"&keyword&page
wstr=getHTTPPage(url)
start=Newstring(wstr,starts)
over=Newstring(wstr,"<div class=""footer"">")
body=mid(wstr,start,over-start)
startt=Newstring(wstr,"<title>")+7
overt=Newstring(wstr,"</title>")
titles=Replace(Replace(mid(wstr,startt,overt-startt),"单机小游戏",title),"djxyx","")
content=NoHref(body)
if content = "" then
tms="1"
else
tms="999"
end if
myCache.add content,dateadd("n",tms,now)
titlesCache.add titles,dateadd("n",tms,now)
end if
set clsCache=nothing
%><!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title><%=titles%></title>
<meta name="keywords" content="<%=keywords%>" />
<meta name="description" content="<%=description%>" />
<link href="img/common.css" rel="stylesheet">
<%if page="" then %>
<link href="img/mainbody.css" rel="stylesheet">
<% elseif InStr(page,"fenlei/")>0 then %>
<link href="img/cate.css" rel="stylesheet">
<% elseif page="paihang/index.html" then %>
<link href="img/topindex.css" rel="stylesheet" type="text/css"/>
<% elseif InStr(page,"youxi/")>0 then %>
<link href="img/gameinfo.css" rel="stylesheet" type="text/css"/>
<% elseif InStr(page,"tuijian/")>0 or InStr(page,"tag/")>0 or InStr(page,"paihang/")>0 then %>
<link href="img/tag2.css" rel="stylesheet" type="text/css" />
<% elseif InStr(page,"kw=")>0 then %>
<link href="img/theme_so.css" rel="stylesheet" type="text/css"/>
<% end if %>
<script language="javascript">
function dosearch(form){
if(form.searchkw.value.replace(/[\s ]+/ig,'')==''){
alert('关键词不能为空');
form.searchkw.focus();
return false;
}
var searchkw = encodeURIComponent(form.searchkw.value.replace(/[\/_]/g,' '));
var url="?kw="+searchkw;
window.location.href=url;
return false;
}
</script>
</head>
<body oncontextmenu=window.event.returnValue=false onselectstart=event.returnValue=false ondragstart=window.event.returnValue=false onsource="event.returnValue=false">
<!--#include file="head.asp"--><%
if content = "" then
Response.Write "<center><h3>数据读取失败~~可能是XMLHTTP组件问题或是服务器所用的DNS解析问题,请换个空间测试一下~~~</h3></center>"
else
Response.Write content
end if
%><!--#include file="bottom.asp"-->
</body>
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
response.codepage="65001"
response.charset="utf-8"
%>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">