這篇文章主要分享了ASP替換、保存遠程圖片的函數代碼,需要的朋友可以參考下
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
函數參數說明:
ConStr:要替換的字符串
參 數:SaveTf:是否保存文件,False不保存,True保存
參 數: TistUrl:當前網頁地址
以上就是ASP替換、保存遠程圖片函數代碼,希望對大家的學習有所幫助。
|
新聞熱點
疑難解答