asp保存远程图片（破防盗链系统）

SaveAddr=Server.MapPath("demo.gif")
SourceURL="http://www.google.cn/intl/zh-CN/images/logo_cn.gif"
Call SaveRemoteFile(SaveAddr,SourceURL)
%>

Set ReF = New Regexp
ReF.IgnoreCase = True
ReF.Global = True
ReF.Pattern = "("&StartStr&").+?("&OverStr&")"
Set Matches =ReF.Execute(ConStr)
For Each Match in Matches
If Instr(TempStr,Match.Value)=0 Then
If TempStr<>"" then
TempStr=TempStr & "$Array$" & Match.Value
Else
TempStr=Match.Value
End if
End If
Next
Set Matches=nothing
Set ReF=nothing
If TempStr="" or IsNull(TempStr)=True Then
ReplaceSaveRemoteFile=ConStr
Exit function
End if
If IncluL=False then
TempStr=Replace(TempStr,StartStr,"")
End if
If IncluR=False then
If Instr(OverStr,"|")>0 Then
OverTypeArray=Split(OverStr,"|")
For Tempi=0 To Ubound(OverTypeArray)
TempStr=Replace(TempStr,OverTypeArray(Tempi),"")
Next
Else
TempStr=Replace(TempStr,OverStr,"")
End If
End if
TempStr=Replace(TempStr,"""","")
TempStr=Replace(TempStr,"'","")

Dim RemoteFile,RemoteFileurl,SaveFileName,SaveFileType,ArrSaveFileName,RanNum
If Right(SaveFilePath,1)="/" then
SaveFilePath=Left(SaveFilePath,Len(SaveFilePath)-1)
End If
If SaveTf=True then
If CheckDir2(SaveFilePath)=False Then
If MakeNewsDir2(SaveFilePath)=False Then
SaveTf=False
End If
End If
End If
SaveFilePath=SaveFilePath & "/"

'图片转换/保存
TempArray=Split(TempStr,"$Array$")
For Tempi=0 To Ubound(TempArray)
RemoteFileurl=DefiniteUrl(TempArray(Tempi),TistUrl)
If RemoteFileurl<>"$False$" And SaveTf=True Then'保存图片
ArrSaveFileName = Split(RemoteFileurl,".")
SaveFileType=ArrSaveFileName(Ubound(ArrSaveFileName))'文件类型
RanNum=Int(900*Rnd)+100
SaveFileName = SaveFilePath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&SaveFileType
Call SaveRemoteFile(SaveFileName,RemoteFileurl)
ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName)
ElseIf RemoteFileurl<>"$False$" and SaveTf=False Then'不保存图片
SaveFileName=RemoteFileUrl
ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName)
End If
If RemoteFileUrl<>"$False$" Then
If UploadFiles="" then
UploadFiles=SaveFileName
Else
UploadFiles=UploadFiles & "|" & SaveFileName
End if
End If
Next
ReplaceSaveRemoteFile=ConStr
End function
'==================================================
'过程名：SaveRemoteFile
'作 用：保存远程的文件到本地
'参 数：LocalFileName ------ 本地文件名
'参 数：RemoteFileUrl ------ 远程文件URL
'==================================================
sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
dim Ads,Retrieval,GetRemoteData
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", RemoteFileUrl, False, "", ""
.Send
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
Set Ads = Server.CreateObject("Adodb.Stream")
With Ads
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile server.MapPath(LocalFileName),2
.Cancel()
.Close()
End With
Set Ads=nothing
end sub

'==================================================
'过程名：GetImg
'作 用：取得文章中第一张图片
'参 数：str ------ 文章内容
'参 数：strpath ------ 保存图片的路径
'==================================================
Function GetImg(str,strpath)
set objregEx = new RegExp
objregEx.IgnoreCase = true
objregEx.Global = true
zzstr=""&strpath&"(.+?).(jpg|gif|png|bmp)"
objregEx.Pattern = zzstr
set matches = objregEx.execute(str)
for each match in matches
retstr = retstr &"|"& Match.Value
next
if retstr<>"" then
Imglist=split(retstr,"|")
Imgone=replace(Imglist(1),strpath,"")
GetImg=Imgone
else
GetImg=""
end if
end function
%>

例:

程序代码
<form id="form1" name="form1" method="post" action="?action=test">
<textarea name="body" cols="50" rows="5" id="body">
<img height="180" src=https://yunqi-tech.oss-cn-hangzhou.aliyuncs.com/200608210738371d0a8.jpg width="240" border="0" />
<img class="left"src=https://yunqi-tech.oss-cn-hangzhou.aliyuncs.com/netease_logo.gif width="114" />
<img height="60" src=https://yunqi-tech.oss-cn-hangzhou.aliyuncs.com/2006081811465369976.jpg width="120" border="0" />
<img height="60" alt="中国维和人数大国之首" src=https://yunqi-tech.oss-cn-hangzhou.aliyuncs.com/200608181506554fd8f.jpg width="120" border="0" />
</textarea>
<input type="submit" name="Submit" value="提交" />
</form>
<%
if request.QueryString("action")="test" then
'图片开始的字符串
FilesStartStr="src="
'图片结束的字符串
FilesOverStr="gif|jpg|bmp"
'保存图片的文件夹
FilesPath="qq"
'取得保存图片的网站URL 自动判断是绝对 还是相对路径
NewsUrl="http://news.163.com"
'取得文章内容
Content =Request.Form("body")
'开始保存图片
Content=ReplaceSaveRemoteFile(Content,FilesStartStr,FilesOverStr,False,True,True,FilesPath,NewsUrl)
'对新闻中的第一张图片创建缩略图
if GetImg(Content,FilesPath)<>"" then
Imgsrc=GetImg(Content,FilesPath)
Imgsrc=replace(Imgsrc,FilesPath,"")
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Path = Server.MapPath(""&FilesPath&"") & ""&Imgsrc&""
Jpeg.Open Path
'如果图片宽小于等于120 高小于等于90 则不创建缩略图
if Jpeg.OriginalWidth<=120 and Jpeg.Height<=90 then
Jpeg.Width = Jpeg.OriginalWidth
Jpeg.Height = Jpeg.OriginalHeight
Smallimg=FilesPath&""&GetImg(Content,FilesPath)
else
'图片宽度高度/2
Jpeg.Width = Jpeg.OriginalWidth / 2
Jpeg.Height = Jpeg.OriginalHeight / 2
Jpeg.Save Server.MapPath(""&FilesPath&"") & "small_"&Imgsrc&""
Smallimg=""&FilesPath&"/small_"&Imgsrc&""
end if
end if
'显示结果
response.Write("新闻中的第一张图片是:")
response.Write("<img src="&FilesPath&"/"&GetImg(Content,FilesPath)&">")
response.Write("<br>新闻中的第一张图片的缩略图是:")
response.Write("<img src="&Smallimg&">")
response.Write("<br>新的新闻内容（图片为本地）:<br>")
Response.Write(Content)
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(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)<now then
                                valid=false
                else
                        valid=true
                end if
        end property
        
        public property let name(str)
                '设置cache名
                cacheName=str & path
                obj=application(cacheName)
                expireTimeName=str & "expires" & path
                expireTime=application(expireTimeName)
        end property
        
        public property let expires
                '重设置过期时间
                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
                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
%>