* Written by Jaron, 2003-11-12 * // * Original: 9CBS Document Center http://www.9cbs.net/develop Web Technology 中文 网 http://www.jaron.cn * // * Reprint Note and retain this copyright message * // * Welcome to use the SiteManager-CMS Server website management system http://siteManager.cnzone.net * // * Automatically create a directory, automatically rename the original file name, file format limit, and other Functions Some Optimization / * Automatically save web files http: // .... Format Picture to Local
Program implementation: Automatically download images in the files of the remote page to your local server
'Save it below Save2Local.asp' test: Save2Local.asp? URL = http://ent.sina.com.cn/s/m/2003-11-11/1411231388.html
<% '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 settings
If createdir (localaddr) = false the replan.write creates a directory failed, please 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 = "
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 & "||" & report (Tmpaddr, "" "," ")," '"," ") 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)) 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 = nothingend 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 nextend 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 & "." & fileextend 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 FunctionFunction getFileExt (Byval FileName) fileext_a = split (filename, ".") GetFighExt = LCase (fileExT_A (Ubound (fileext_a)) End Function%>
