The following is a function to extract the image address in HTML:
the main principle is to use regular expressions to determine the <src> attribute of <img>. This will be very useful in acquisition programs.
The function is as follows:
The following is a quote fragment:
Function ShowPic(str)
Set objRegExp = New Regexp'set configuration object
objRegExp.IgnoreCase = True'Ignore case
objRegExp.Global = True' set to full text search
objRegExp.Pattern = "<img.+?>"
'In order to ensure that the image address can be retrieved accurately, it is divided into two levels of configuration: first find the <img> tag inside, and then retrieve the image address inside. The getimgs function behind it implements the latter function.
strs=trim(str)
Set Matches =objRegExp.Execute(strs)'Start executing configuration
For Each Match in Matches
RetStr = RetStr &getimgs( Match.Value )'Perform the second round of matching
Next
ShowPic = RetStr
End Function
Function getimgs(str)
getimgs=""
Set objRegExp1 = New Regexp
objRegExp1.IgnoreCase = True
objRegExp1.Global = True
objRegExp1.Pattern = " http://.+?"""' Get the address inside
set mm=objRegExp1.Execute(str)
For Each Match1 in mm
getimgs=getimgs&left(Match1.Value,len(Match1.Value)-1)&"||"'String the addresses inside for later use
next
End Function
'Get image content
function getHTTPage(url)
on error resume next
dim http
set http=server.createobject("MSXML2.XMLHTTP")'Use xmlhttp method to obtain the content of the image
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=Http.responseBody
set http=nothing
if err.number<>0 then err.Clear
end function
'Save picture
function saveimage(from,tofile)
dim geturl,objStream,imgs
geturl=trim(from)
imgs=gethttppage(geturl)'The process of obtaining the specific content of the image
Set objStream = Server.CreateObject("ADODB.Stream")' To create an ADODB.Stream object, ADO 2.5 or above is required
objStream.Type =1'Open in binary mode
objStream.Open
objstream.write imgs' writes the string content into the buffer
objstream.SaveToFile server.mappath(tofile),2'-write the buffered content to the file
objstream.Close()'Close the object
set objstream=nothing
end function
'Call instance
Dim strpic,i,fname
strpic = ShowPic("<DIV align=center><IMG src="" strpic = Split(strpic,"||")
If UBound(strpic) > 0 Then
For i = 0 To UBound(strpic) - 1
'Save picture
fname=cstr(i&mid(strpic(i),instrrev(strpic(i),".")))
saveimage(strpic(i),fname)
Next
Else
End If