这是采集一条新闻，并将新闻中的图片保存到本机中去，再将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,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")
就可以了，其他的不变
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。