大灰狼的ASP工具箱——自动获得远程图片 #Write　By Jaron

2022-07-15 80酷酷网 80kuku.com

程序实现功能：自动将远程页面的文件中的图片下载到本地服务器

'将下文保存为 save2local.asp
'测试：save2local.asp?url=http://ent.sina.com.cn/s/m/2003-11-11/1411231388.html

<%
'参数设置开始
url = request("url")
localaddr = server.MapPath("images_remote/") '保存到本地的目录
localdir = "images_remote/" 'http 访问的相对路径
AllowFileExt = "jpg|bmp|png|gif" '支持的文件名格式
'参数设置完毕

if createdir(localaddr) = false then
response.Write "创建目录失败，请检查目录权限"
response.End
end if
response.Write Convert2LocalAddr(url,localaddr,localdir)

function Convert2LocalAddr(url,localaddr,localdir)
'参数说明
'url 页面地址
'localaddr 保存本地的物理地址
'localdir 相对路径
strContent = getHTTPPage(url)
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<img.+?>"
Set Matches =objRegExp.Execute(strContent)
For Each Match in Matches
RetStr = RetStr & GetRemoteImages(Match.Value)
Next
ImagesArray=split(RetStr,"||")
RemoteImage=""
LocalImage=""
for i=1 to ubound(ImagesArray)
if ImagesArray(i)<>"" and instr(RemoteImage,ImagesArray(i))<1 then
   fname=baseurl&cstr(i&mid(ImagesArray(i),instrrev(ImagesArray(i),".")))
   ImagesFileName = ImagesArray(i)
   AllowFileExtArray = split(AllowFileExt,"|")
   isGetFile = false
   for tmp = 0 to ubound(AllowFileExtArray)
    if lcase(GetFileExt(ImagesFileName)) = ALlowFileExtArray(tmp) then
     isGetFile=True
    end if
   next
   if isGetFile = true then
    newfilename = GenerateRandomFileName(fname)
    call Save2Local(ImagesFileName,localaddr & "/" & newfilename)
    RemoteImage=RemoteImage&"||"& ImagesFileName
    LocalImage=LocalImage&"||" & localdir & newfilename
   end if
end if
next
arrnew=split(LocalImage,"||")
arrall=split(RemoteImage,"||")
for i=1 to ubound(arrnew)
strContent=replace(strContent,arrall(i),arrnew(i))
next
Convert2LocalAddr = strContent
end function

function GetRemoteImages(str)
Set objRegExp1 = New Regexp
objRegExp1.IgnoreCase = True
objRegExp1.Global = True
objRegExp1.Pattern = "http://.+? "
set mm=objRegExp1.Execute(str)
For Each Match1 in mm
tmpaddr = left(Match1.Value,len(Match1.Value)-1)
GetRemoteImages=GetRemoteImages&"||" & replace(replace(tmpaddr,"""",""),"'","")
next
end function

function getHTTPPage(url)
on error resume next
dim http
set http=Server.createobject("Msxml2.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then exit function
getHTTPPage=bytes2BSTR(Http.responseBody)
set http=nothing
if err.number<>0 then err.Clear
end function

Function bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
   strReturn = strReturn & Chr(ThisCharCode)
Else
   NextCharCode = AscB(MidB(vIn,i+1,1))
   strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
   i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function

function getHTTPimg(url)
on error resume next
dim http
set http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then exit function
getHTTPimg=Http.responseBody
set http=nothing
if err.number<>0 then err.Clear
end function

function Save2Local(from,tofile)
dim geturl,objStream,imgs
geturl=trim(from)
imgs=gethttpimg(geturl)
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type =1
objStream.Open
objstream.write imgs
objstream.SaveToFile tofile,2
objstream.Close()
set objstream=nothing
end function

function geturlencodel(byval url)'中文文件名转换
Dim i,code
geturlencodel=""
if trim(Url)="" then exit function
for i=1 to len(Url)
code=Asc(mid(Url,i,1))
if code<0 Then code = code + 65536
If code>255 Then
getu

大灰狼的ASP工具箱——自动获得远程图片 #Write By Jaron

大灰狼的ASP工具箱——自动获得远程图片 #Write　By Jaron