将html代码中的图片保存到指定的文件夹中去，再替换掉html中的图片路径

这是采集一条新闻，并将新闻中的图片保存到本机中去，再将html代码中的图片路径换成本机图片路径的例子。这个可适用于把编辑器中外网图片保存到本服务器上来。

<
%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<
%'检查本地文件是否存在 参数为文件物理路径Function CheckFileExists(PhFileName)Dim blCheck,FsoblCheck = TrueSet Fso = CreateObject("Scripting.FileSystemObject")If Not Fso.FileExists(PhFileName) ThenblCheck = FalseEnd IfSet Fso = NothingCheckFileExists = blCheck'True 文件已经存在，False文件不存在End Function'将内容写入本地文件Sub CreateTempFile(PhFileName,strFile)Dim Fso, MyFileSet Fso = CreateObject("Scripting.FileSystemObject")Set MyFile = fso.CreateTextFile(PhFileName, True)MyFile.Write strFileSet MyFile = NothingSet Fso = NothingEnd Sub'================================================'作  用：替换字符串中的远程文件为本地文件并保存远程文件'参  数：'sHTML: 要替换的字符串'sSavePath: 保存文件的路径'sExt: 执行替换的扩展名'================================================Function ReplaceRemoteUrl(sHTML, sSavePath, sExt)Dim s_Contents_Content = sHTMLIf IsObjInstalled("Microsoft.XMLHTTP") = False thenReplaceRemoteUrl = s_ContentExit FunctionEnd IfIf sSavePath = "" Then sSavePath = "./"If sExt = "" Then sExt = "jpg|gif|bmp|png"Dim re, RemoteFile, RemoteFileurl, SaveFileName, SaveFileTypeSet re = new RegExpre.IgnoreCase  = Truere.Global = Truere.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\)
{1}((\w)+[.])
{1,}(net|com|cn|org|cc|tv|[0-9]
{1,3})(\S*\/)((\S)+[.]
{1}(" &
 sExt &
 ")))"Set RemoteFile = re.Execute(s_Content)For Each RemoteFileurl in RemoteFileSaveFileType = Mid(RemoteFileurl, InstrRev(RemoteFileurl, ".") + 1)    Dim iiia=Split(RemoteFileurl,"/")iii1 = a(UBound(a))j=0While CheckFileExists(iii1) j=j+1 iii1=j&
iii1 wend     iii=Split(iii1,".")(0)SaveFileName = sSavePath&
iii&
"."&
SaveFileTypeCall SaveRemoteFile(SaveFileName, RemoteFileurl)s_Content = Replace(s_Content,RemoteFileurl,SaveFileName)NextReplaceRemoteUrl = s_ContentEnd Function'================================================'作  用：保存远程的文件到本地'参  数：LocalFileName ------ 本地文件名'RemoteFileUrl ------ 远程文件URL'返回值：True  ----成功'       False ----失败'================================================Sub SaveRemoteFile(s_LocalFileName,s_RemoteFileUrl)Dim Ads, Retrieval, GetRemoteData'On Error Resume Next'Set Retrieval = Server.CreateObject("Micro"&
aa&
"soft.XMLHTTP")Set Retrieval = Server.CreateObject("Micro"&
aa&
"soft.XMLHTTP")With Retrieval.Open "Get", s_RemoteFileUrl, False, "", "".SendGetRemoteData = .ResponseBodyEnd WithSet Retrieval = NothingSet Ads = Server.CreateObject("Adod"&
aabb&
"b.Stream")With Ads.Type = 1.Open.Write GetRemoteData.SaveToFile Server.MapPath(s_LocalFileName), 2.Cancel().Close()End WithSet Ads=nothingEnd Sub'================================================'作  用：检查组件是否已经安装'参  数：strClassString ----组件名'返回值：True  ----已经安装'        False ----没有安装'================================================Function IsObjInstalled(s_ClassString)'On Error Resume NextIsObjInstalled = FalseErr = 0Dim xTestObjSet xTestObj = Server.CreateObject(s_ClassString)If 0 = Err Then IsObjInstalled = TrueSet xTestObj = NothingErr = 0End Function'==========================================='作用：获取指定url地址的源文件'参数：url为指定的网址'      language为该页面的编码'返回值:html源文件'===========================================Function getHTTPPage(url,language) 'On Error Resume Nextdim http set http=Server.createobject("Microsoft.XMLHTTP") Http.open "GET",url,false Http.send() if Http.readystate<
>
4 thenexit function end if getHTTPPage=bytesToBSTR(Http.responseBody,language)set http=NothingIf Err.number<
>
0 then Response.Write "<
p align='center'>
<
font color='red'>
<
b>
服务器获取文件内容出错<
/b>
<
/font>
<
/p>
" Err.ClearEnd If  End FunctionFunction BytesToBstr(body,Cset)dim objstreamset objstream = Server.CreateObject("adodb.stream")objstream.Type = 1objstream.Mode =3objstream.Openobjstream.Write bodyobjstream.Position = 0objstream.Type = 2objstream.Charset = CsetBytesToBstr = objstream.ReadText objstream.Closeset objstream = nothingEnd Function%>

上面是一些常用的函数，不要修改它

下面是使用上面的函数，保存图片功能

<
%url="http://www.K88.NET/tech/showtech.asp?id=1109"str=getHTTPPage(url,"utf-8")str=ReplaceRemoteUrl(str, "pic/", "") '这里的pic是图片在本机上的文件夹response.write str%>

以上是采集新闻，保存图片功能，如果你要保存编辑器中的图片，改一下这个地方

url="http://www.K88.NET/tech/showtech.asp?id=1109"str=getHTTPPage(url,"utf-8")

改成

str=request("content")

就可以了，其他的不变