将代码保存为asp文件,连接方式如pic.asp?url=地址
<%
'盗链判断
If Instr(Request.ServerVariables("http_referer"),"http://"&Request.ServerVariables("server_name")&"") = 0 Then
Response.Write "非法链接"
Response.End
End If
Dim url, body, myCache
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()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 Cacheclass Cache
private obj 'cache内容
private expireTime '过期时间
private expireTimeName '过期时间application名
private cacheName 'cache内容application名
private path 'url
private Sub class_initialize()sub class_initialize()
path=request.servervariables("url")
path=left(path,instrRev(path,"/"))
end sub
private Sub class_terminate()sub class_terminate()
end sub
public Property get()property get blEmpty
'是否为空
if isempty(obj) then
blEmpty=true
else
blEmpty=false
end if
end property
public Property get()property get valid
'是否可用(过期)
if isempty(obj) or not isDate(expireTime) then
valid=false
elseif CDate(expireTime) valid=false
else
valid=true
end if
end property
public Property let()property let name(str)
'设置cache名
cacheName=str & path
obj=application(cacheName)
expireTimeName=str & "expires" & path
expireTime=application(expireTimeName)
end property
public Property let()property let expires(tm)
'重设置过期时间
expireTime=tm
application.lock
application(expireTimeName)=expireTime
application.unlock
end property
public Sub add()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()property get value
'取值
if isempty(obj) or not isDate(expireTime) then
value=null
elseif CDate(expireTime) value=null
else
value=obj
end if
end property
public Sub makeEmpty()sub makeEmpty()
'释放application
application.lock
application(cacheName)=empty
application(expireTimeName)=empty
application.unlock
obj=empty
expireTime=empty
end sub
public Function equal()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
%>
将代码保存为asp文件,连接方式如pic.asp?地址
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936" ENABLESESSIONSTATE="FALSE"%>
<%Option Explicit%>
<%
'+---------------------------------------------------------+
'| Aocool Studio Photo / Gallery Magic Show |
'| Copyright (c) 2005 - 2006 Aocool Studio Ltd. |
'+---------------------------------------------------------+
Server.ScriptTimeout = 300
Response.Buffer = True
On Error Resume Next
Function IsNullOrEmpty()Function IsNullOrEmpty(ByVal String)
IsNullOrEmpty = IsNull(String) Or String = ""
End Function
Function GetImage()Function GetImage(ByVal URL)
Dim oXmlHttp
Set oXmlHttp = Server.CreateObject("Msxml2.XMLHTTP")
If Err.Number <> 0 Then
Response.Write("XMLHTTP Object not installed on this server, please go to Microsoft website download and install it.")
Response.End()
End If
oXmlHttp.Open "GET", URL, False
oXmlHttp.setRequestHeader "Referer", URL
oXmlHttp.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727)"
oXmlHttp.Send()
If oXmlHttp.readyState <> 4 Then
GetImage = ""
Else
GetImage = oXmlHttp.responseBody
End If
Set oXmlHttp = Nothing
End Function
Function GetContentType()Function GetContentType(ByVal FileName)
Dim FileExtension, ContentType
FileExtension = Mid(FileName, InStrRev(FileName, ".") + 1)
Select Case FileExtension
Case "jpe"
ContentType = "image/jpeg"
Case "jpg"
ContentType = "image/jpeg"
Case "jpeg"
ContentType = "image/jpeg"
Case "gif"
ContentType = "image/gif"
Case "bmp"
ContentType = "image/bmp"
Case "png"
ContentType = "image/png"
Case "pnz"
ContentType = "image/png"
Case Else
ContentType = "text/html"
End Select
GetContentType = ContentType
End Function
Dim URL, Bin
URL = Request.ServerVariables("QUERY_STRING")
Bin = GetImage(URL)
If IsNullOrEmpty(URL) = False Then
If Bin <> "" Then
Response.ContentType = GetContentType(URL)
Response.BinaryWrite Bin
Response.Flush
Else
Response.ContentType = "text/html"
Response.Write("Remote Server Error.")
End If
Else
Response.ContentType = "text/html"
Response.Status = "400 Bad Request"
Response.Write("400 Bad Request")
End If
%>
引用格式：get163.php?p=地址
//远程调用163相册图片
//http://blog.cnstorm.com
//Ian.Lee
//2006-3-5
$p=$_GET["p"];
if(!preg_match("/http:\/\/img([0-9]+).photo.163.com\/([a-z0-9_-]+)\/([0-9]+)\/([0-9]+).(gif|jpg)/i",$p))exit();//这个正则你可以替换下
if (substr($p,-4)==".jpg")
{header("Content-type: image/jpeg\n\n");}
else
{header("Content-type: image/gif\n\n");}
@readfile($p);
?>
做了一个网易相册贴图代码生成器
http://www.mysea.net/download/js/163pic.html
本文作者:佚名 来源:本站原创
CIO之家 www.ciozj.com 微信公众号:imciow