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

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

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
'检查本地文件是否存在 参数为文件物理路径
Function CheckFileExists(PhFileName)
	Dim blCheck,Fso
	blCheck = True
	Set Fso = CreateObject("Scripting.FileSystemObject")
	If Not Fso.FileExists(PhFileName) Then
		blCheck = False
	End If
	Set Fso = Nothing
	CheckFileExists = blCheck
	'True 文件已经存在，False文件不存在
End Function

'将内容写入本地文件
Sub CreateTempFile(PhFileName,strFile)
	Dim Fso, MyFile
	Set Fso = CreateObject("Scripting.FileSystemObject")
	Set MyFile = fso.CreateTextFile(PhFileName, True)
	MyFile.Write strFile
	Set MyFile = Nothing
	Set Fso = Nothing
End Sub

'================================================
'作  用：替换字符串中的远程文件为本地文件并保存远程文件
'参  数：
'	sHTML		: 要替换的字符串
'	sSavePath	: 保存文件的路径
'	sExt		: 执行替换的扩展名
'================================================
Function ReplaceRemoteUrl(sHTML, sSavePath, sExt)
	Dim s_Content
	s_Content = sHTML
	If IsObjInstalled("Microsoft.XMLHTTP") = False then
		ReplaceRemoteUrl = s_Content
		Exit Function
	End If
	
	If sSavePath = "" Then sSavePath = "./"
	If sExt = "" Then sExt = "jpg|gif|bmp|png"
	Dim re, RemoteFile, RemoteFileurl, SaveFileName, SaveFileType
	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}(" & sExt & ")))"
	Set RemoteFile = re.Execute(s_Content)
	For Each RemoteFileurl in RemoteFile
		SaveFileType = Mid(RemoteFileurl, InstrRev(RemoteFileurl, ".") + 1)

	    Dim iii
	a=Split(RemoteFileurl,"/")
	iii1 = a(UBound(a))
	j=0
	While CheckFileExists(iii1)
	 j=j+1
	 iii1=j&iii1	 
	wend 
    iii=Split(iii1,".")(0)
		SaveFileName = sSavePath&iii&"."&SaveFileType
		Call SaveRemoteFile(SaveFileName, RemoteFileurl)
		s_Content = Replace(s_Content,RemoteFileurl,SaveFileName)
	Next
	ReplaceRemoteUrl = s_Content
End 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, "", ""
		.Send
		GetRemoteData = .ResponseBody
	End With
	Set Retrieval = Nothing
	Set Ads = Server.CreateObject("Adod"&aabb&"b.Stream")
	With Ads
		.Type = 1
		.Open
		.Write GetRemoteData
		.SaveToFile Server.MapPath(s_LocalFileName), 2
		.Cancel()
		.Close()
	End With
	Set Ads=nothing
End Sub

'================================================
'作  用：检查组件是否已经安装
'参  数：strClassString ----组件名
'返回值：True  ----已经安装
'        False ----没有安装
'================================================
Function IsObjInstalled(s_ClassString)
	'On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(s_ClassString)
	If 0 = Err Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
End Function

'===========================================
'作用：获取指定url地址的源文件
'参数：url为指定的网址
'      language为该页面的编码
'返回值:html源文件
'===========================================
Function getHTTPPage(url,language) 
	'On Error Resume Next
	dim http 
	set http=Server.createobject("Microsoft.XMLHTTP") 
	Http.open "GET",url,false 
	Http.send() 
	if Http.readystate<>4 then
		exit function 
	end if 
	getHTTPPage=bytesToBSTR(Http.responseBody,language)
	set http=Nothing	
	If Err.number<>0 then 
		Response.Write "<p align='center'><font color='red'><b>服务器获取文件内容出错</b></font></p>" 
		Err.Clear
	End If  
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
%>

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

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

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

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

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

改成

str=request("content")

就可以了，其他的不变