ASP替换、保存远程图片实现代码

ASP通过函数来实现替换、保存远程图片，完成自动采集图片、提取图片的功能，函数中自动判断重复图片，智能分析链接路径，并转成成相对的图片地址保存在你指定的网站目录中，我们可将此函数用在后台的编辑器中，当你复制了含有图片的内容后，本代码会自动帮你上传图片。同时本代码也是采集程序中的重要处理函数，函数代码如下：

Function ReplaceSaveRemoteFile(ConStr,strInstallDir,strChannelDir,SaveTf,TistUrl)If ConStr="$False$" or ConStr="" or strInstallDir="" or strChannelDir="" ThenReplaceSaveRemoteFile=ConStrExit FunctionEnd IfDim TempStr,TempStr2,TempStr3,Re,Matches,Match,Tempi,TempArray,TempArray2Set Re = New RegexpRe.IgnoreCase = TrueRe.Global = TrueRe.Pattern ="]>"Set Matches =Re.Execute(ConStr)For Each Match in MatchesIf TempStr<>"" thenTempStr=TempStr & "$Array$" & Match.ValueElseTempStr=Match.ValueEnd ifNextIf TempStr<>"" ThenTempArray=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 MatchesIf TempStr<>"" thenTempStr=TempStr & "$Array$" & Match.ValueElseTempStr=Match.ValueEnd ifNextNextEnd ifIf TempStr<>"" ThenRe.Pattern ="src/s*=/s*"TempStr=Re.Replace(TempStr,"")End IfSet Matches=nothingSet Re=nothingIf TempStr="" or IsNull(TempStr)=True ThenReplaceSaveRemoteFile=ConStrExit functionEnd ifTempStr=Replace(TempStr,"""","")TempStr=Replace(TempStr,"'","")TempStr=Replace(TempStr," ","")Dim RemoteFileurl,SavePath,PathTemp,DtNow,strFileName,strFileType,ArrSaveFileName,RanNum,Arr_PathDtNow=Now()If SaveTf=True thenSavePath= 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 ThenPathTemp=Arr_Path(0) & "/"ElseIf Tempi=Ubound(Arr_Path) ThenExit ForElsePathTemp=PathTemp & Arr_Path(Tempi) & "/"End IfIf CheckDir(PathTemp)=False ThenIf MakeNewsDir(PathTemp)=False ThenSaveTf=FalseExit ForEnd IfEnd IfNextEnd If'去掉重复图片TempArray=Split(TempStr,"$Array$")TempStr=""For Tempi=0 To Ubound(TempArray)If Instr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1 ThenTempStr=TempStr & "$Array$" & TempArray(Tempi)End IfNextTempStr=Right(TempStr,Len(TempStr)-7)TempArray=Split(TempStr,"$Array$")'转换相对图片地址TempStr=""For Tempi=0 To Ubound(TempArray)TempStr=TempStr & "$Array$" & DefiniteUrl(TempArray(Tempi),TistUrl)NextTempStr=Right(TempStr,Len(TempStr)-7)TempStr=Replace(TempStr,Chr(0),"")TempArray2=Split(TempStr,"$Array$")TempStr=""'图片替换/保存Set Re = New RegexpRe.IgnoreCase = TrueRe.Global = TrueFor 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" thenUploadFiles=""ReplaceSaveRemoteFile=ConStrExit FunctionEnd IfRandomizeRanNum=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 & "." & strFileTypeRe.Pattern =TempArray(Tempi)  If SaveRemoteFile(SavePath & strFileName,RemoteFileUrl)=True Then'********************************PathTemp=SavePath & strFileNameConStr=Re.Replace(ConStr,PathTemp)Re.Pattern=strInstallDir & strChannelDir & "/"UploadFiles=UploadFiles & "|" & Re.Replace(SavePath &strFileName,"")ElsePathTemp=RemoteFileUrlConStr=Re.Replace(ConStr,PathTemp)'UploadFiles=UploadFiles & "|" & RemoteFileUrlEnd IfElseIf RemoteFileurl<>"$False$" and SaveTf=False Then'不保存图片Re.Pattern =TempArray(Tempi)ConStr=Re.Replace(ConStr,RemoteFileUrl)UploadFiles=UploadFiles & "|" & RemoteFileUrlEnd IfNextSet Re=nothingIf UploadFiles<>"" ThenUploadFiles=Right(UploadFiles,Len(UploadFiles)-1)End IfReplaceSaveRemoteFile=ConStrEnd function