To friends who want to learn XMLHTTP (automatically download images from files on remote pages to a local device)

Program Function: Automatically downloads images from files on the remote page to the local device.

Save this article as save2local. asp
Test: save2local. asp? Url = http://ent.sina.com.cn/s/m/2003-11-11/1411231388.html
This article is adapted and optimized based on chinahuman's "Using ASP to automatically parse image addresses in webpages and save them to local servers"
Automatically create a directory and rename the original file name, restrict the file format, and optimize other functions.
Automatically save the http: //... Format Image in the webpage file to the local device.

Parameter Setting starts
Url = request ("url ")
Localaddr = server. mappath ("images_remote/") 'is saved to the local directory.
Localdir = "images_remote/" 'relative path of HTTP access
Allowfileext = "JPG | BMP | PNG | GIF" 'supported file name formats
'Parameter set

If createdir (localaddr) = false then
Response. Write "failed to create directory. Please check the directory permission"
Response. End
End if
Response. Write convert2localaddr (URL, localaddr, localdir)

Function convert2localaddr (URL, localaddr, localdir)
'Parameter description
'Url page address
'Localaddr saves 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 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), limit Rev (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)
STRC (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 mattings in mm
Tmpaddr = left (match1.value, Len (match1.value)-1)
Getremoteimages = getremoteimages & "|" & 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) 'conversion of Chinese file names
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 & gt; 255 then
Geturlencodel = geturlencodel & "%" & left (hex (CODE), 2) & "%" & right (hex (CODE), 2)
Else
Geturlencodel = geturlencodel & Mid (URL, I, 1)
End if
Next
End Function

function generaterandomfilename (byval szfilename) 'automatically generates a new file name in date YYYY-MM-DD-RANDOM format based on the original file name
randomize
rannum = int (90000 * RND) + 10000
If month (now) <10 then c_month = "0" & month (now) else c_month = month (now)
If Day (now) <10 then c_day = "0" & Day (now) else c_day = Day (now)
If hour (now) <10 then c_hour = "0" & hour (now) else c_hour = hour (now)
If minute (now) <10 then c_minute = "0" & minute (now) else c_minute = minute (now)
if second (now) <10 then c_second = "0" & Second (now) else c_second = minute (now)
fileext_a = Split (szfilename ,". ")
fileext = lcase (fileext_a (ubound (fileext_a)
generaterandomfilename = year (now) & c_month & c_day & c_hour & c_minute & c_second & "_" & rannum &". "& fileext
end function

Function createdir (byval localpath) 'creates a directory program. If there is a multi-level directory, it is created at the first level.
On Error resume next
Localpath = Replace (localpath ,"\","/")
Set fileobject = server. Createobject ("scripting. FileSystemObject ")
Patharr = Split (localpath ,"/")
Path_level = ubound (patharr)
For I = 0 to path_level
If I = 0 then pathtmp = patharr (0) & "/" else pathtmp = pathtmp & patharr (I )&"/"
Cpath = left (pathtmp, Len (pathtmp)-1)
If not fileobject. folderexists (cpath) Then fileobject. createfolder cpath
Next
Set fileobject = nothing
If err. Number <> 0 then
Createdir = false
Err. Clear
Else
Createdir = true
End if
End Function

Function getfileext (byval filename)
Fileext_a = Split (filename ,".")
Getfileext = lcase (fileext_a (ubound (fileext_a )))
End Function
%>

It is worth noting that only the addresses of images starting with HTTP are analyzed here. Otherwise, you can convert the address without downloading the image. Then, you can provide several small functions to analyze the address:

Function findurl (thisurl)
If thisurl <> "" then
Findurl = ""
Strlen = instr (8, thisurl ,"/")
If strlen = 0 then strlen = 1
Findurl = mid (thisurl, strlen, 28)
End if
End Function

Function findurlpath (thisurl)
Thisurl = Replace (thisurl ,"//","@@")
Ary_tmp = Split (thisurl ,"/")
For TMP = 0 to ubound (ary_tmp)
If TMP <ubound (ary_tmp) then
Urltmp = urltmp & "/" & ary_tmp (TMP)
End if
Next
Urltmp = right (urltmp, Len (urltmp)-1)
Findurlpath = Replace (urltmp ,"@@","//")&"/"
End Function

Function findurlhost (thisurl)
Thisurl = Replace (thisurl ,"//","@@")
Ary_tmp = Split (thisurl ,"/")
Urltmp = ary_tmp (0)
Findurlhost = Replace (urltmp ,"@@","//")&"/"
Findurlhost = left (findurlhost, Len (findurlhost)-1)
End Function
Reprinted please indicate the source: www.sanyalanhua.com