ASP替換、保存遠(yuǎn)程圖片實(shí)現(xiàn)代碼
ASP通過函數(shù)來(lái)實(shí)現(xiàn)替換、保存遠(yuǎn)程圖片,完成自動(dòng)采集圖片、提取圖片的功能,函數(shù)中自動(dòng)判斷重復(fù)圖片,智能分析鏈接路徑,并轉(zhuǎn)成成相對(duì)的圖片地址保存在你指定的網(wǎng)站目錄中,我們可將此函數(shù)用在后臺(tái)的編輯器中,當(dāng)你復(fù)制了含有圖片的內(nèi)容后,本代碼會(huì)自動(dòng)幫你上傳圖片。同時(shí)本代碼也是采集程序中的重要處理函數(shù),函數(shù)代碼如下:
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 '去掉重復(fù)圖片 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$") '轉(zhuǎn)換相對(duì)圖片地址 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
函數(shù)參數(shù)說(shuō)明:
ConStr:要替換的字符串
參 數(shù):SaveTf:是否保存文件,F(xiàn)alse不保存,True保存
參 數(shù): TistUrl:當(dāng)前網(wǎng)頁(yè)地址
以上就是ASP替換、保存遠(yuǎn)程圖片函數(shù)代碼,希望對(duì)大家的學(xué)習(xí)有所幫助。
相關(guān)文章
如何從數(shù)據(jù)庫(kù)中隨機(jī)取出10條記錄的方法
如何從數(shù)據(jù)庫(kù)中隨機(jī)取出10條記錄的方法...2007-01-01asp連接mysql數(shù)據(jù)庫(kù)詳細(xì)實(shí)現(xiàn)代碼
文章詳細(xì)的介紹在asp中如何來(lái)連接mysql數(shù)據(jù)庫(kù)并查出數(shù)據(jù)并輸出,同時(shí)也介紹了連接mysql核心代碼及中文亂碼解決辦法2012-04-04asp 通用數(shù)據(jù)庫(kù)連接過程函數(shù)
asp 通用數(shù)據(jù)庫(kù)連接過程函數(shù)...2007-08-08asp下實(shí)現(xiàn)IP限制函數(shù)代碼
asp下實(shí)現(xiàn)IP限制函數(shù)代碼...2007-11-11