server | download | page * Written by Jaron, 2003-11-12 * *
* Original source: CSDN Document Center Http://www.csdn.net/develop web Technology Chinese Network http://www.jaron.cn * *
* Reprint Please specify the source and retain this copyright information * *
* * Welcome to use the Sitemanager-cms Server Web site Management System http://sitemanager.cnzone.net * *
/* Automatically create a directory, automatically renamed the original file name, file format restrictions and other features of some optimization
/* Automatically save http://in Web page file .... Picture of the format to the local
Program implementation function: Automatically download pictures of files from remote pages to local server
' Save the following as Save2local.asp
' Test: save2local.asp?url=http://ent.sina.com.cn/s/m/2003-11-11/1411231388.html
<%
' Parameter settings start
url = Request ("url")
LOCALADDR = Server. MapPath ("images_remote/") ' Save to local directory
Localdir = "images_remote/" ' relative path to HTTP access
allowfileext = filename format supported by "Jpg|bmp|png|gif"
' Parameter set complete
If Createdir (localaddr) = False Then
Response. Write "Failed to create directory, please check directory permissions"
Response. End
End If
Response. Write convert2localaddr (Url,localaddr,localdir)
function Convert2localaddr (url,localaddr,localdir)
' Parameter description
' URL page address
' LOCALADDR Save the local physical address
' Localdir relative path
strcontent = gethttppage (URL)
Set objRegExp = New Regexp
Objregexp.ignorecase = True
Objregexp.global = True
Objregexp.pattern = "Set matches =objregexp.execute (strcontent)
For the 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
The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion;
products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the
content of the page makes you feel confusing, please write us an email, we will handle the problem
within 5 days after receiving your email.
If you find any instances of plagiarism from the community, please send an email to:
info-contact@alibabacloud.com
and provide relevant evidence. A staff member will contact you within 5 working days.