Save the remote image to a local device and obtain the first image and create a thumbnail.

The following are functions

<%
'================================================ ==============
'Function name: checkdir2
'Usage: Check whether the folder exists
'Parameter: folderpath ------ folder address
'================================================ ==============
Function checkdir2 (byval folderpath)
Dim FSO
Folderpath = server. mappath (".") & "\" & folderpath
Set FSO = server. Createobject ("scripting. FileSystemObject ")
If FSO. folderexists (folderpath) then
'Exist
Checkdir2 = true
Else
'Does not exist
Checkdir2 = false
End if
Set FSO = nothing
End Function
'================================================ ==============
'Function name: makenewsdir2
'For use: create a new folder
'Parameter: Foldername ------ folder name
'================================================ ==============
Function makenewsdir2 (byval Foldername)
Dim FSO
Set FSO = server. Createobject ("scripting. FileSystemObject ")
FSO. createfolder (server. mappath (".") & "\" & Foldername)
If FSO. folderexists (server. mappath (".") & "\" & Foldername) then
Makenewsdir2 = true
Else
Makenewsdir2 = false
End if
Set FSO = nothing
End Function
'================================================ ==============
'Function name: definiteurl
'For use: Convert relative addresses to absolute addresses
'Parameter: primitiveurl ------ relative address to be converted
'Parameter: consulturl ------ current webpage address
'================================================ ==============
Function definiteurl (byval primitiveurl, byval consulturl)
Dim Contemp, pritemp, PI, CI, priarray, conarray
If primitiveurl = "" Or consulturl = "" Or primitiveurl = "$ false $" then
Definiteurl = "$ false $"
Exit Function
End if
If left (consulturl, 7) <> "http: //" and left (consulturl, 7) <> "http: //" then
Consulturl = "http: //" & consulturl
End if
Consulturl = Replace (consulturl ,"://",":\\")
If right (consulturl, 1) <> "/" then
If instr (consulturl, "/")> 0 then
If instr (right (consulturl, Len (consulturl)-limit Rev (consulturl, "/"), ".")> 0 then
Else
Consulturl = consulturl &"/"
End if
Else
Consulturl = consulturl &"/"
End if
End if
Conarray = Split (consulturl ,"/")
If left (primitiveurl, 7) = "http: //" then
Definiteurl = Replace (primitiveurl ,"://",":\\")
Elseif left (primitiveurl, 1) = "/" then
Definiteurl = conarray (0) & primitiveurl
Elseif left (primitiveurl, 2) = "./" then
Definiteurl = conarray (0) & right (primitiveurl, Len (primitiveurl)-1)
Elseif left (primitiveurl, 3) = "../" then
Do While left (primitiveurl, 3) = "../"
Primitiveurl = right (primitiveurl, Len (primitiveurl)-3)
Pi = PI + 1
Loop
For CI = 0 to (ubound (conarray)-1-Pi)
If definiteurl <> "" then
Definiteurl = definiteurl & "/" & conarray (CI)
Else
Definiteurl = conarray (CI)
End if
Next
Definiteurl = definiteurl & "/" & primitiveurl
Else
If instr (primitiveurl, "/")> 0 then
Priarray = Split (primitiveurl ,"/")
If instr (priarray (0), ".")> 0 then
If right (primitiveurl, 1) = "/" then
Definiteurl = "http: \" & primitiveurl
Else
If instr (priarray (ubound (priarray)-1), ".")> 0 then
Definiteurl = "http: \" & primitiveurl
Else
Definiteurl = "http: \" & primitiveurl &"/"
End if
End if
Else
If right (consulturl, 1) = "/" then
Definiteurl = consulturl & primitiveurl
Else
Definiteurl = left (consulturl, inclurev (consulturl, "/") & primitiveurl
End if
End if
Else
If instr (primitiveurl, ".")> 0 then
If right (consulturl, 1) = "/" then
If right (primitiveurl, 3) = ". CN "or right (primitiveurl, 3) =" com "or right (primitiveurl, 3) =" Net "or right (primitiveurl, 3) =" org "then
Definiteurl = "http: \" & primitiveurl &"/"
Else
Definiteurl = consulturl & primitiveurl
End if
Else
If right (primitiveurl, 3) = ". CN "or right (primitiveurl, 3) =" com "or right (primitiveurl, 3) =" Net "or right (primitiveurl, 3) =" org "then
Definiteurl = "http: \" & primitiveurl &"/"
Else
Definiteurl = left (consulturl, limit Rev (consulturl, "/") & "/" & primitiveurl
End if
End if
Else
If right (consulturl, 1) = "/" then
Definiteurl = consulturl & primitiveurl &"/"
Else
Definiteurl = left (consulturl, inclurev (consulturl, "/") & "/" & primitiveurl &"/"
End if
End if
End if
End if
If left (definiteurl, 1) = "/" then
Definiteurl = right (definiteurl, Len (definiteurl)-1)
End if
If definiteurl <> "" then
Definiteurl = Replace (definiteurl ,"//","/")
Definiteurl = Replace (definiteurl ,":\\","://")
Else
Definiteurl = "$ false $"
End if
End Function
'================================================ ==============
'Function name: replacesaveremotefile
'For use: replace and save remote files
'Parameter: constr ------ string to be replaced
'Parameter: starstr ----- leading
'Parameter: overstr -----
'Parameter: inclul ------
'Parameter: inclur ------
'Parameter: savetf ------ whether to save the file; false: Not saved; true: Saved
'Parameter: SaveFilePath-save folder
'Parameter: tisturl ------ current webpage address
'================================================ ==============
Function replacesaveremotefile (constr, startstr, overstr, inclul, inclur, savetf, SaveFilePath, tisturl)
If constr = "$ false $" or constr = "" then
Replacesaveremotefile = "$ false $"
Exit Function
End if
Dim tempstr, tempstr2, ref, matches, match, tempi, temparray, temparray2, overtypearray

Set ref = new Regexp
Ref. ignorecase = true
Ref. Global = true
Ref. pattern = "(" & startstr & "). +? ("& Overstr &")"
Set matches = ref. Execute (constr)
For each match in matches
If instr (tempstr, match. Value) = 0 then
If tempstr <> "" then
Tempstr = tempstr & "$ array $" & Match. Value
Else
Tempstr = match. Value
End if
End if
Next
Set matches = nothing
Set ref = nothing
If tempstr = "" Or isnull (tempstr) = true then
Replacesaveremotefile = constr
Exit Function
End if
If inclul = false then
Tempstr = Replace (tempstr, startstr ,"")
End if
If inclur = false then
If instr (overstr, "|")> 0 then
Overtypearray = Split (overstr, "| ")
For tempi = 0 to ubound (overtypearray)
Tempstr = Replace (tempstr, overtypearray (tempi ),"")
Next
Else
Tempstr = Replace (tempstr, overstr ,"")
End if
End if
Tempstr = Replace (tempstr ,"""","")
Tempstr = Replace (tempstr ,"'","")

Dim remotefile, remotefileurl, savefilename, savefiletype, arrsavefilename, rannum
If right (SaveFilePath, 1) = "/" then
SaveFilePath = left (SaveFilePath, Len (SaveFilePath)-1)
End if
If savetf = true then
If checkdir2 (SaveFilePath) = false then
If makenewsdir2 (SaveFilePath) = false then
Savetf = false
End if
End if
End if
SaveFilePath = SaveFilePath &"/"

'Image conversion/saving
Temparray = Split (tempstr, "$ array $ ")
For tempi = 0 to ubound (temparray)
Remotefileurl = definiteurl (temparray (tempi), tisturl)
If remotefileurl <> "$ false $" and savetf = true then' Save the image
Arrsavefilename = Split (remotefileurl ,".")
Savefiletype = arrsavefilename (ubound (arrsavefilename) 'file type
Rannum = int (900 * RND) + 100
Savefilename = SaveFilePath & year (now) & month (now) & Day (now) & hour (now) & minute (now) & Second (now) & rannum &". "& savefiletype
Call saveremotefile (savefilename, remotefileurl)
Constr = Replace (constr, temparray (tempi), savefilename)
Elseif remotefileurl <> "$ false $" and savetf = false then' do not save the image
Savefilename = remotefileurl
Constr = Replace (constr, temparray (tempi), savefilename)
End if
If remotefileurl <> "$ false $" then
If uploadfiles = "" then
Uploadfiles = savefilename
Else
Uploadfiles = uploadfiles & "|" & savefilename
End if
End if
Next
Replacesaveremotefile = constr
End Function
'================================================ ==============
'Process name: saveremotefile
'Usage: Save the remote file to the local device.
'Parameter: localfilename ------ local file name
'Parameter: remotefileurl ------ Remote File URL
'================================================ ==============
Sub saveremotefile (localfilename, remotefileurl)
Dim ads, retrieval, getremotedata
Set retrieval = server. Createobject ("Microsoft. XMLHTTP ")
With Retrieval
. Open "get", remotefileurl, false ,"",""
. Send
Getremotedata =. responsebody
End
Set retrieval = nothing
Set ads = server. Createobject ("ADODB. Stream ")
With ads
. Type = 1
. Open
. Write getremotedata
. Savetofile server. mappath (localfilename), 2
. Cancel ()
. Close ()
End
Set ads = nothing
End sub

'================================================ ==============
'Process name: getimg
'Usage: Get the first image in the article
'Parameter: Str ------ content of the article
'Parameter: strpath ------ path for saving the image
'================================================ ==============
Function getimg (STR, strpath)
Set objregex = new Regexp
Objregex. ignorecase = true
Objregex. Global = true
Zzstr = "" & strpath & "(. + ?) \. (JPG | GIF | PNG | BMP )"
Objregex. pattern = zzstr
Set matches = objregex.exe cute (STR)
For each match in matches
Retstr = retstr & "|" & Match. Value
Next
If retstr <> "" then
Imglist = Split (retstr, "| ")
Imgone = Replace (imglist (1), strpath ,"")
Getimg = imgone
Else
Getimg = ""
End if
End Function
%>

The following is an example<Form ID = "form1" name = "form1" method = "Post" Action = "? Action = test ">
<Textarea name = "body" Cols = "50" rows = "5" id = "body">




</Textarea>
<Input type = "Submit" name = "Submit" value = "Submit"/>
</Form>
<%
If request. querystring ("action") = "test" then
'Image start string
Filesstartstr = "src ="
'Image end string
Filesoverstr = "GIF | JPG | BMP"
'Save the image folder
Filespath = "QQ"
'Get the URL of the website that saves the image and automatically determine whether it is an absolute or relative path.
Newsurl = "http://news.163.com"
'Get the article content
Content = request. Form ("body ")
'Start saving the image
Content = replacesaveremotefile (content, filesstartstr, filesoverstr, false, true, true, filespath, newsurl)
'Create a thumbnail for the first image in the news
If getimg (content, filespath) <> "" then
Imgsrc = getimg (content, filespath)
Imgsrc = Replace (imgsrc, filespath ,"")
Set JPEG = server. Createobject ("persits. jpeg ")
Path = server. mappath ("" & filespath & "") & "\" & imgsrc &""
JPEG. Open Path
'If the image width is less than or equal to 120, and the height is less than or equal to 90, no thumbnail is created.
If jpeg. originalwidth <= 120 and JPEG. height <= 90 then
JPEG. width = jpeg. originalwidth
JPEG. Height = jpeg. originalheight
Smallimg = filespath & "& getimg (content, filespath)
Else
'Image width and height/2
JPEG. width = jpeg. originalwidth/2
JPEG. Height = jpeg. originalheight/2
JPEG. Save server. mappath ("" & filespath & "") & "\ small _" & imgsrc &""
Smallimg = "" & filespath & "/small _" & imgsrc &""
End if
End if
'Display result
Response. Write ("the first picture in the news is :")
Response. Write (" ")
Response. Write ("<br> the thumbnail of the first image in the news is :")
Response. Write (" ")
Response. Write ("<br> new news content (picture is local): <br> ")
Response. Write (content)
Response. End ()
End if
%>