Program implementation: Automatically download images in the files of the remote page to your local.
<% '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 based on ChinaHuman Use the ASP to automatically parse the image address in the page, and save it to the local server "to" Automatically create the directory, automatically save the original file name rename, the file format limit, and some other functions "automatically save the web file HTTP: // .... Picture of the format to the local 'reprint, please indicate the source: http://www.jaron.cn http://www.9cbs.net/develop' parameter setting 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 setting is completed
If createdir (localaddr) = false the replanse.write creates a directory failed, please check the directory permissions "response.end endiffddr (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 = "
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) -1) getRemoteImages = getRemoteImages & "|" & Replace (Replace (Tmpaddr, "" "," ")," '"," ") Next End 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)) 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 functionfunction geturlencodel (byval url) 'Chinese file name conversion 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 Ten 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) This automatically generates new file name Randomize Rannum = int (90000 * rND) 10000 if Month (now) <10 TEN C_MONTH = "0" according to the original file name & 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 TEN C_MINUTE = "0" & Minute (now) Else C_minute = Minute (now) if Second (now) <10 TEN 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) 'Established a directory, if there is a multi-level directory, the first-class first level creates 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 FunctionFunction getFileExt (Byval FileName) FileExT_A = Split (FileName, ".") Getfileext = lcase (fileExt_a (userxt_a)) End function%>
One thing to note is that here is just the address of the picture starting with HTTP. Otherwise, do not download the picture, you can convert the address, then provide a few small functions, analyze the address:
Function Findurl (thisurl) if thisURL <> ""1 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
