ASP通过函数来实现替换、保存远程图片，完成自动采集图片、提取图片的功能，函数中自动判断重复图片，智能分析链接路径，并转成成相对的图片地址保存在你指定的网站目录中，我们可将此函数用在后台的编辑器中，当你复制了含有图片的内容后，本代码会自动帮你上传图片。同时本代码也是采集程序中的重要处理函数，函数代码如下：
Function ReplaceSaveRemoteFile(ConStr,strInstallDir,strChannelDir,SaveTf,TistUrl)
If ConStr="$False$" or ConStr="" or strInstallDir="" or strChannelDir="" Then
ReplaceSaveRemoteFile=ConStr
Exit Function
End If
Dim TempStr,TempStr2,TempStr3,Re,Matches,Match,Tempi,TempArray,TempArray2
Set Re = New Regexp
Re.IgnoreCase = True
Re.Global = True
Re.Pattern ="]>"
Set Matches =Re.Execute(ConStr)
For Each Match in Matches
If TempStr>"" then
TempStr=TempStr "$Array$" Match.Value
Else
TempStr=Match.Value
End if
Next
If TempStr>"" Then
TempArray=Split(TempStr,"$Array$")
TempStr=""
For Tempi=0 To Ubound(TempArray)
Re.Pattern ="src\s*=\s*.+?\.(gif|jpg|bmp|jpeg|psd|png|svg|dxf|wmf|tiff)"
Set Matches =Re.Execute(TempArray(Tempi))
For Each Match in Matches
If TempStr>"" then
TempStr=TempStr "$Array$" Match.Value
Else
TempStr=Match.Value
End if
Next
Next
End if
If TempStr>"" Then
Re.Pattern ="src\s*=\s*"
TempStr=Re.Replace(TempStr,"")
End If
Set Matches=nothing
Set Re=nothing
If TempStr="" or IsNull(TempStr)=True Then
ReplaceSaveRemoteFile=ConStr
Exit function
End if
TempStr=Replace(TempStr,"""","")
TempStr=Replace(TempStr,"'","")
TempStr=Replace(TempStr," ","")
Dim RemoteFileurl,SavePath,PathTemp,DtNow,strFileName,strFileType,ArrSaveFileName,RanNum,Arr_Path
DtNow=Now()
If SaveTf=True then
SavePath= strChannelDir "/" year(DtNow) right("0" month(DtNow),2) "/"
response.write "链接路径：" savepath ""
Arr_Path=Split(SavePath,"/")
PathTemp=""
For Tempi=0 To Ubound(Arr_Path)
If Tempi=0 Then
PathTemp=Arr_Path(0) "/"
ElseIf Tempi=Ubound(Arr_Path) Then
Exit For
Else
PathTemp=PathTemp Arr_Path(Tempi) "/"
End If
If CheckDir(PathTemp)=False Then
If MakeNewsDir(PathTemp)=False Then
SaveTf=False
Exit For
End If
End If
Next
End If
'去掉重复图片
TempArray=Split(TempStr,"$Array$")
TempStr=""
For Tempi=0 To Ubound(TempArray)
If Instr(Lcase(TempStr),Lcase(TempArray(Tempi)))1 Then
TempStr=TempStr "$Array$" TempArray(Tempi)
End If
Next
TempStr=Right(TempStr,Len(TempStr)-7)
TempArray=Split(TempStr,"$Array$")
'转换相对图片地址
TempStr=""
For Tempi=0 To Ubound(TempArray)
TempStr=TempStr "$Array$" DefiniteUrl(TempArray(Tempi),TistUrl)
Next
TempStr=Right(TempStr,Len(TempStr)-7)
TempStr=Replace(TempStr,Chr(0),"")
TempArray2=Split(TempStr,"$Array$")
TempStr=""
'图片替换/保存
Set Re = New Regexp
Re.IgnoreCase = True
Re.Global = True
For Tempi=0 To Ubound(TempArray2)
RemoteFileUrl=TempArray2(Tempi)
If RemoteFileUrl>"$False$" And SaveTf=True Then'保存图片
ArrSaveFileName = Split(RemoteFileurl,".")
strFileType=Lcase(ArrSaveFileName(Ubound(ArrSaveFileName)))'文件类型
If strFileType="asp" or strFileType="asa" or strFileType="aspx" or strFileType="cer" or strFileType="cdx" or strFileType="exe" or strFileType="rar" or strFileType="zip" then
UploadFiles=""
ReplaceSaveRemoteFile=ConStr
Exit Function
End If
Randomize
RanNum=Int(900*Rnd)+100
strFileName = year(DtNow) right("0" month(DtNow),2) right("0" day(DtNow),2) right("0" hour(DtNow),2) right("0" minute(DtNow),2) right("0" second(DtNow),2) ranNum "." strFileType
Re.Pattern =TempArray(Tempi)
If SaveRemoteFile(SavePath strFileName,RemoteFileUrl)=True Then
'********************************
PathTemp=SavePath strFileName
ConStr=Re.Replace(ConStr,PathTemp)
Re.Pattern=strInstallDir strChannelDir "/"
UploadFiles=UploadFiles "|" Re.Replace(SavePath strFileName,"")
Else
PathTemp=RemoteFileUrl
ConStr=Re.Replace(ConStr,PathTemp)
'UploadFiles=UploadFiles "|" RemoteFileUrl
End If
ElseIf RemoteFileurl>"$False$" and SaveTf=False Then'不保存图片
Re.Pattern =TempArray(Tempi)
ConStr=Re.Replace(ConStr,RemoteFileUrl)
UploadFiles=UploadFiles "|" RemoteFileUrl
End If
Next
Set Re=nothing
If UploadFiles>"" Then
UploadFiles=Right(UploadFiles,Len(UploadFiles)-1)
End If
ReplaceSaveRemoteFile=ConStr
End function
