ASP下载网页内的图片实例

王朝asp·作者佚名  2006-11-24
窄屏简体版  字體: |||超大  

<%

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 & ")))"

's_Content="http://union.3721.com/v2/images/sicon.gif sfsdf"

response.write s_Content

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://www.webjx.com/htmldata/2006-02-20/1140402873.html"'接收的网址

code=replace(getHTTPPage(url),vbcrlf,"")'替换掉代码中的 回车符

start=Instr(code,"<html>")'开始的代码 这里取网页中有唯一性质的 代码开始

over=Instr(code,"</html>")'结束的代码 这里取网页中有唯一性质的 代码结束

types=mid(code,start,over-start) 'types 变量就是你需要的部分

'//这里应该继续对取得后的代码做休整 以便符合自己需要

'//我才取的是从<html>到</html> 所以是读整个页面 实际上根据自己需要查看人家的代码 对照下

'//实际上还需要一些其他的函数 比如整理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

%>

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航