asp将html代码中的图片保存到指定的文件夹中去,再替换asp

/ / 2016-07-24   阅读:2500
这是采集一条新闻,并将新闻中的图片保存到本机中去,再将html代码中的图片路径换成本机图片路径的例子。这个可适用于把编辑器中外网图片保存到本服务器上来。 <%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%> <...
这是采集一条新闻,并将新闻中的图片保存到本机中去,再将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")
就可以了,其他的不变

我要评论

昵称:
验证码:

最新评论

共0条 共0页 10条/页 首页 上一页 下一页 尾页
意见反馈