<%
'盗链判断
Dim server_v1,server_v2
server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
'Response.Write server_v1 &"
"
'Response.Write server_v2 &"
"
'Response.End
If Mid(server_v1,8,len(server_v2))<>server_v2 Then
'Response.Write "非法的盗链"
'Response.End
End If
if request.QueryString("id")="" then
response.write "抱歉，数据参数有误，请返回"
response.end
end if
dim picidh,picpgh,picno,piczdh,picfsObj,picfilepath,pictxtobj,picstrtxt,picurl
picidh=int(request.QueryString("id"))
picno=int(request.QueryString("no"))
if (picno="" or picno=0) then
picno=1
end if
picpgh=int((picidh-1)/100+1)
set picfsObj=server.CreateObject("scripting.filesystemobject")
picfilepath=server.MapPath("jkpiclb/jkpiclb"&picpgh&".tat")
'response.write picfilepath
'response.end
set pictxtobj=picfsObj.OpenTextFile(picfilepath,1,false)
if pictxtobj.atendofstream=false then
picstrtxt=pictxtobj.readall
else
picstrtxt=""
end if
pictxtobj.close
Set picfsObj=nothing
'Response.Write picstrtxt&"
"
piczdh="zd"&picno&"="
picstrtxt=GetContent(picstrtxt,"{{"&picidh&"}}","{{",0)
'Response.Write picstrtxt
'Response.end
'picurl=GetContent(picstrtxt,piczdh,"|||",0)
picurl=split(picstrtxt,"|")(1)
'picurl="http://fzytsra.blu.livefilestore.com/y1pSItSQ-Iv23WbXfT1qlZy922r-_OK3bBJIJCJV88EdSRQKopMAT40xTDTBcYP_mk7nHvhX0PmX3NuZINDW8Mz4w/qqt2.gap"
'picurl="http://img.cxdq.com/090723/2009723105714787.jpg"
'
'Dim url, body, myCache
url=picurl
'response.write url
'response.end
if InStr(lcase("http://"),lcase(picurl))=0 then
url="http://"&server_v2&"/"&url
end if
'Response.Write url
'Response.end
'url = Request.QueryString("url")
Set myCache = new cache
myCache.name = "picindex"&url
If myCache.valid Then
body = myCache.value
Else
body = GetWebData(url)
myCache.add body,dateadd("d",1,now)
End If
If Err.Number = 0 Then
Response.CharSet = "UTF-8"
Response.ContentType = "application/octet-stream"
Response.BinaryWrite body
Response.Flush
Else
Wscript.Echo Err.Description
End if
'取得数据
Public Function GetWebData(ByVal strUrl)
Dim curlpath
curlpath = Mid(strUrl,1,Instr(8,strUrl,"/"))
Dim Retrieval
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", strUrl, False,"",""
.setRequestHeader "Referer", curlpath
.Send
GetWebData =.ResponseBody
End With
Set Retrieval = Nothing
End Function
'cache类
class Cache
private obj 'cache内容
private expireTime '过期时间
private expireTimeName '过期时间application名
private cacheName 'cache内容application名
private path 'url
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)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
Function GetContent(str,start,last,n)
If Instr(lcase(str),lcase(start))>0 then
select case n
case 0 '左右都截取（都取前面）（去处关键字）
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))-1)
case 1 '左右都截取（都取前面）（保留关键字）
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))+Len(last)-1)
case 2 '只往右截取（取前面的）（去除关键字）
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
end select
Else
GetContent=""
End if
End function
%>