ASP保存远程图片到本地 同时取得第一张图片并创(3)

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 & "/"
'图片转换/保存
TempArray=Split(TempStr,"$Array$")
For Tempi=0 To Ubound(TempArray)
RemoteFileurl=DefiniteUrl(TempArray(Tempi),TistUrl)
If RemoteFileurl<>"$False$" And SaveTf=True Then'保存图片
ArrSaveFileName = Split(RemoteFileurl,".")
SaveFileType=ArrSaveFileName(Ubound(ArrSaveFileName))'文件类型
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'不保存图片
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
'==================================================
'过程名：SaveRemoteFile
'作 用：保存远程的文件到本地
'参 数：LocalFileName ------ 本地文件名
'参 数：RemoteFileUrl ------ 远程文件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 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
'==================================================
'过程名：GetImg
'作 用：取得文章中第一张图片
'参 数：str ------ 文章内容