Here is a function to remove the address of the image inside the HTML: the main principle is to use the regular judgment <src> attribute. This will be very useful in the acquisition program.
The functions are as follows:
The following is a reference fragment:
Function showpic (str)
Set objregexp = New Regexp ' Set Configuration object
Objregexp.ignorecase = True ' ignores case
Objregexp.global = True ' Set to Full-text search
Objregexp.pattern = "
In order to ensure that the image can be accurately removed, it is divided into two-tier configuration: First find the inside of the tag, and then remove the image inside the Getimgs function is to achieve the latter function.
Strs=trim (str)
Set matches =objregexp.execute (STRs) ' Starts execution configuration
For the Match in matches
Retstr = Retstr &getimgs (match.value) ' performs a second-round match
Next
Showpic = Retstr
End Function
Function Getimgs (str)
Getimgs= ""
Set OBJREGEXP1 = New Regexp
Objregexp1.ignorecase = True
Objregexp1.global = True
Objregexp1.pattern = "http://.+?" "" ' Take out the address inside.
Set Mm=objregexp1.execute (str)
For each Match1 in mm
Getimgs=getimgs&left (Match1.value,len (Match1.value)-1) & "" ' Put the address of the inside string up for backup
Next
End Function
' Get picture content
function gethttppage (URL)
On Error Resume Next
Dim http
Set Http=server.createobject ("Msxml2.xmlhttp") ' uses XMLHTTP method to get the contents of a picture
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 content of a picture
Set objstream = Server.CreateObject ("ADODB. Stream ")" To create a ADODB.stream object that must be ADO more than 2.5 version
objStream.Type = 1 ' Open in binary mode
objStream.Open
Objstream.write IMGs ' writes string contents to buffer
Objstream. SaveToFile Server.MapPath (ToFile), 2 '-writes buffered content to file
Objstream. Close () ' Closes object
Set objstream=nothing
End Function
' Invoke instance
Dim Strpic,i,fname
Strpic = Showpic ("<div align=center> ")
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