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
新聞熱點
疑難解答