自动将远程页面的文件中的图片下载到本地服务器[1]

* written by jaron ,2003-11-12 */
/* 原出处：csdn文档中心 http://www.csdn.net/develop web技术中文网 http://www.jaron.cn */
/* 转载请注明出处和保留此版权信息 */
/* 欢迎使用sitemanager-cms server 网站管理系统 http://sitemanager.cnzone.net  */
/* 自动创建目录，自动将原文件名更名，文件格式的限制以及其他功能的一些优化
/* 自动保存网页文件中 http://.... 格式的图片到本地

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

'将下文保存为 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)