Program implementation: Automatically download images in the files of the remote page to your local.
Program code: <% 'Save this article as save2local.asp' test: Save2local.asp? Url = http://ent.sina.com.cn/s/m/2003-11-11/1411231388.html ' ChinaHuman "Automatically parsed the image address in the web page," and save it to the local server "to automatically create a directory, automatically save the original file name, the file format limit, and some other optimization 'auto-save web files in
http: // ....
Picture of the format to local 'reprint, please indicate:
http://www.jaron.cn http://www.9cbs.net/develop
'Parameter Settings Start URL = Request ("URL") localaddr = server.mappath ("Images_remote /")' Save to Local Directory localdir = "Images_remote /" 'http Access relative path allowfileext = "JPG | BMP | PNG | gif " 'supported file name format' parameter is set up if createdir (localaddr) = false then response.Write" failed to create directory, check the directory permissions "response.Endend ifresponse.Write Convert2LocalAddr (url, localaddr, localdir) function Convert2LocalAddr ( url, localaddr, localdir) 'parameter' url page address 'localaddr locally stored physical address' localdir relative path strContent = getHTTPPage (url) Set objRegExp = New Regexp objRegExp.IgnoreCase = True objRegExp.Global = True objRegExp.Pattern = "
"/" & 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 = strContentend functionfunction 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 = getRemoteImteimages & "|" & replace (REPAADDR, "" ", ""), "'", "") Nextend FunctionFunction 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)) ife = 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 functionfunction 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 = nothingend functionfunction geturlencodel (byval url) 'Chinese file name conversion Dim i, code geturlencodel = "" if trim ( URL) = "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" & Left (HEX (CODE), 2) & "%" & Right (HEX (CODE), 2) Else geturlencodel = geturlencodel & mid (URL, I, 1) end if nextend function function generandomfilename (Byval SzFileName) 'According to the original file name, automatic Generate new file name Randomize Rannum = int (90000 * rND) 10000 if Month (now) <10 TEN C_MONTH = "0" & MONTH (NOW) ELSE C_MONTH = MONTH (now) If Day (now) <10 TEN C_DAY = "0" & day (now) Else C_DAY = day (now) if Hour (now) <10 TEN C_HOUR = "0" & Hour (now) else c_Hour = Hour (now) IF minute (now) <10 THEN C_MINUTE = "0" & minute (now) ELSE C_MI Nute = minute (now) if second (now) <10 dam c_second = "0" & second (now) fileext_a = split (szfilename, ".") fileext = lcase (fileExt_a ))) & C_month & c_second & "" & rannum & "& fileextend FunctionFunction CreateDir (Byval LocalPath) 'Establishing a program of the directory, if there is a multi-level directory Create an on Error Resume next localpath =
