以下是取出HTML里面的图片地址的函数
主要原理就是用正则判断 <img> 的<src>属性这在采集程序中将非常有用
函数如下
以下是引用片段
Function ShowPic(str)
Set objRegExp = New Regexp设置配置对象
objRegExpIgnoreCase = True忽略大小写
objRegExpGlobal = True设置为全文搜索
objRegExpPattern = <img+?>
为了确保能准确地取出图片地址所以分为两层配置首先找到里面的<img>标签然后再取出里面的图片地址后面的getimgs函数就是实现后一个功能的
strs=trim(str)
Set Matches =objRegExpExecute(strs)开始执行配置
For Each Match in Matches
RetStr = RetStr &getimgs( MatchValue )执行第二轮的匹配
Next
ShowPic = RetStr
End Function
Function getimgs(str)
getimgs=
Set objRegExp = New Regexp
objRegExpIgnoreCase = True
objRegExpGlobal = True
objRegExpPattern = +?取出里面的地址
set mm=objRegExpExecute(str)
For Each Match in mm
getimgs=getimgs&left(MatchValuelen(MatchValue))&||把里面的地址串起来备用
next
End Function
取得图片内容
function getHTTPPage(url)
on error resume next
dim http
set (MSXMLXMLHTTP)使用xmlhttp的方法来获得图片的内容
Httpopen GETurlfalse
Httpsend()
if Httpreadystate<> then
exit function
end if
getHTTPPage=HttpresponseBody
set http=nothing
if errnumber<> then errClear
end function
保存图片
function saveimage(fromtofile)
dim geturlobjStreamimgs
geturl=trim(from)
imgs=gethttppage(geturl)取得图片的具休内容的过程
Set objStream = ServerCreateObject(ADODBStream)建立ADODBStream对象必须要ADO 以上版本
objStreamType =以二进制模式打开
objStreamOpen
objstreamwrite imgs将字符串内容写入缓沖
objstreamSaveToFile servermappath(tofile)将缓沖的内容写入文件
objstreamClose()关闭对象
set objstream=nothing
end function
调用实例
Dim strpicifname
strpic = ShowPic(<DIV align=center><IMG src=_//gif border=></DIV>)
strpic = Split(strpic||)
If UBound(strpic) > Then
For i = To UBound(strpic)
保存图片
fname=cstr(i&mid(strpic(i)instrrev(strpic(i))))
saveimage(strpic(i)fname)
Next
Else
End If
