代码如下： <% Function ReplaceRemoteUrl(sHTML, sSaveFilePath, sFileExt) '// '//远程保存图片 '/ '作 用：替换字符串中的远程文件为本地文件并保存远程文件 '参 数： ' sHTML : 要替换的字符串 ' sSavePath : 保存文件的路径 ' sExt : 执行替换的扩展名 Dim s_Content s_Content = sHTML 'If IsObjInstalled("Microsoft.XMLHTTP") = False then 'ReplaceRemoteUrl = s_Content ' Exit Function ' End If '远程图片保存目录,结尾请不要加“/” SaveFilePath="/upload" '远程图片保存类型 FileExt="jpg|gif|bmp|png" Dim re, RemoteFile, RemoteFileurl,SaveFileName,SaveFileType,arrSaveFileNameS,arrSaveFileName,sSaveFilePaths Set re = new RegExp re.IgnoreCase = True re.Global = True re.Pattern = "((http|https|ftp|rtsp|mms):(|){1}((/w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(/S*//)((/S)+[.]{1}(" & sFileExt & ")))" Set RemoteFile = re.Execute(s_Content) For Each RemoteFileurl in RemoteFile SaveFileType = Replace(Replace(RemoteFileurl,"/", "a"), ":", "a") 'arrSaveFileName = Right(SaveFileType,12) arrSaveFileName = Mid(RemoteFileurl,InStrRev(RemoteFileurl, "/")+1) sSaveFilePaths=sSaveFilePath & "/" SaveFileName = sSaveFilePaths & arrSaveFileName Call SaveRemoteFile(SaveFileName, RemoteFileurl) s_Content = Replace(s_Content,RemoteFileurl,SaveFileName) Next ReplaceRemoteUrl = s_Content End Function Sub SaveRemoteFile(LocalFileName,RemoteFileUrl) Dim Ads, Retrieval, GetRemoteData On Error Resume Next Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "Get", RemoteFileUrl, False, "", "" .Send GetRemoteData = .ResponseBody End With Set Retrieval = Nothing Set Ads = Server.CreateObject("Adodb.Stream") With Ads .Type = 1 .Open .Write GetRemoteData .SaveToFile Server.MapPath(LocalFileName), 2 .Cancel() .Close() End With Set Ads=nothing End Sub Server.scriptTimeOut=6000 '页面超时时间 url="http://gamezone.qq.com/ahttps://files.jxasp.com/image/20040917/000070.htm";'接收的网址 code=replace(getHTTPPage(url),vbcrlf,"")'替换掉代码中的 回车符 start=Instr(code,"")'开始的代码 这里取网页中有唯一性质的 代码开始 over=Instr(code,"")'结束的代码 这里取网页中有唯一性质的 代码结束 types=mid(code,start,over-start) 'types 变量就是你需要的部分 '//这里应该继续对取得后的代码做休整 以便符合自己需要 '//我才取的是从到 所以是读整个页面 实际上根据自己需要查看人家的代码 对照下 '//实际上还需要一些其他的函数 比如整理HTML标志符的函数, 自动接收远程图片的函数 '//还有就是页面的自动跳转等 == 这个就看自己的扩展了 types=ReplaceRemoteUrl(types,SaveFilePath,FileExt)//下载远程图片 response.write types ' 测试输出 '下边的函数不用管, 包括 打开,读取,网页 Function getHTTPPage(Path) t = GetBody(Path) getHTTPPage=BytesToBstr(t,"GB2312") End function Function GetBody(url) on error resume next Set Retrieval = CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "Get", url, False, "", "" .Send GetBody = .ResponseBody End With Set Retrieval = Nothing End Function Function BytesToBstr(body,Cset) dim objstream set objstream = Server.CreateObject("adodb.stream") objstream.Type = 1 objstream.Mode =3 objstream.Open objstream.Write body objstream.Position = 0 objstream.Type = 2 objstream.Charset = Cset BytesToBstr = objstream.ReadText objstream.Close set objstream = nothing End Function %>
