<% '盗链判断 Dim server_v1,server_v2,id,no server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) if request.QueryString("id")="" then 'response.write "抱歉，数据参数有误，请返回" 'response.end end if '测试叠加图 'url="http://1852.img.pp.sohu.com.cn/images/2010/4/11/17/12/1289e8b5b6dg214.jpg" idh=int(request.QueryString("id")) no=int(request.QueryString("no")) pgh=int((idh-1)/200+1) jqh="{"&idh&"}" dim body,url,urlfs body="" body=ReadBinFile(Server.MapPath("swjztpdz1.tat"),1) url=GetContent(body,"{"&cstr(pgh)&"}","{",0) if instr(url,"http://")>0 then urlfs=1 else urlfs=0 end if if urlfs=0 then body=ReadBinFile(Server.MapPath(url),0) else body=GetWebData(url) end if dim binbh,ii,cd1,cd2,binbh2 binbh=chrb(123) for ii=1 to len(cstr(idh)) binbh=binbh & chrb(asc(mid(cstr(idh),ii,1))) next binbh=binbh&chrb(125) binbh2=chrb(123) for ii=1 to len(cstr(idh+1)) binbh2=binbh2 & chrb(asc(mid(cstr(idh+1),ii,1))) next binbh2=binbh2&chrb(125) cd1=InStrB(body,binbh) cd2=InStrB(body,binbh2) if cd2<=0 then cd2=lenb(body) end if if cd1>0 then body=midb(body,cd1+2+len(cstr(idh)),cd2-cd1+1) end if ' response.write len(body)&"|"&no&"
" if no=0 or no="" then cd1=InStrB(body,chrb(asc("z"))&chrb(asc("d"))&chrb(asc("|"))) cd2=InStrB(body,chrb(asc("z"))&chrb(asc("d"))&chrb(asc("1"))&chrb(asc("|"))) ' response.write cd1&"|"&cd2 ' response.end if cd2<=0 then cd2=lenb(body) end if if cd1>0 then body=midb(body,cd1+3,cd2-cd1+1) end if else binbh=chrb(asc("z"))+chrb(asc("d")) for ii=1 to len(cstr(no)) binbh=binbh & chrb(asc(mid(cstr(no),ii,1))) next binbh=binbh&chrb(asc("|")) binbh2=chrb(asc("z"))+chrb(asc("d")) for ii=1 to len(cstr(no+1)) binbh2=binbh2 & chrb(asc(mid(cstr(no+1),ii,1))) next binbh2=binbh2&chrb(asc("|")) cd1=InStrB(body,binbh) cd2=InStrB(body,binbh2) if cd2<=0 then cd2=lenb(body) end if if cd1>0 then body=midb(body,cd1+3+len(cstr(no)),cd2-cd1+1) end if 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 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 Function ReadBinFile(fileName,dqfs) Dim objStream,bin Set objStream = Server.CreateObject("ADODB.Stream") objStream.Open if dqfs=0 then objStream.Type = 1 objStream.LoadFromFile fileName bin = objStream.Read objStream.Close Set objStream = Nothing ReadBinFile = bin else objStream.type=2 objStream.LoadFromFile fileName objStream.Charset = "GB2312" objStream.Position = 2 bin=objStream.readtext objStream.Close Set objStream = Nothing ReadBinFile = bin end if End Function %>