电脑知识|欧美黑人一区二区三区|软件|欧美黑人一级爽快片淫片高清|系统|欧美黑人狂野猛交老妇|数据库|服务器|编程开发|网络运营|知识问答|技术教程文章 - 好吧啦网

您的位置:首頁技術文章
文章詳情頁

ASP替換、保存遠程圖片實現代碼

瀏覽:155日期:2022-06-05 16:40:28

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替換、保存遠程圖片函數代碼,希望對大家的學習有所幫助。

標簽: ASP
主站蜘蛛池模板: 专业生物有机肥造粒机,粉状有机肥生产线,槽式翻堆机厂家-郑州华之强重工科技有限公司 | 超声波反应釜【百科】-以马内利仪器 | 玻璃钢罐_玻璃钢储罐_盐酸罐厂家-河北华盛节能设备有限公司 | 江苏全风,高压风机,全风环保风机,全风环形高压风机,防爆高压风机厂家-江苏全风环保科技有限公司(官网) | 油液红外光谱仪-油液监测系统-燃油嗅探仪-上海冉超光电科技有限公司 | 艺术涂料_进口艺术涂料_艺术涂料加盟_艺术涂料十大品牌 -英国蒙太奇艺术涂料 | 微信聊天记录恢复_手机短信删除怎么恢复_通讯录恢复软件下载-快易数据恢复 | 光谱仪_积分球_分布光度计_灯具检测生产厂家_杭州松朗光电【官网】 | 汽车整车综合环境舱_军标砂尘_盐雾试验室试验箱-无锡苏南试验设备有限公司 | 专注提供国外机电设备及配件-工业控制领域一站式服务商-深圳市华联欧国际贸易有限公司 | 废气处理设备-工业除尘器-RTO-RCO-蓄热式焚烧炉厂家-江苏天达环保设备有限公司 | 上海律师咨询_上海法律在线咨询免费_找对口律师上策法网-策法网 广东高华家具-公寓床|学生宿舍双层铁床厂家【质保十年】 | 曙光腾达官网-天津脚手架租赁-木板架出租-移动门式脚手架租赁「免费搭设」 | 船老大板材_浙江船老大全屋定制_船老大官网| 焊接烟尘净化器__焊烟除尘设备_打磨工作台_喷漆废气治理设备 -催化燃烧设备 _天津路博蓝天环保科技有限公司 | 脱硝喷枪-氨水喷枪-尿素喷枪-河北思凯淋环保科技有限公司 | 体感VRAR全息沉浸式3D投影多媒体展厅展会游戏互动-万展互动 | 避光流动池-带盖荧光比色皿-生化流动比色皿-宜兴市晶科光学仪器 东莞爱加真空科技有限公司-进口真空镀膜机|真空镀膜设备|Polycold维修厂家 | 阴离子_阳离子聚丙烯酰胺厂家_聚合氯化铝价格_水处理絮凝剂_巩义市江源净水材料有限公司 | 广州云仓代发-昊哥云仓专业电商仓储托管外包代发货服务 | 拉力机-万能试验机-材料拉伸试验机-电子拉力机-拉力试验机厂家-冲击试验机-苏州皖仪实验仪器有限公司 | 彼得逊采泥器-定深式采泥器-电动土壤采样器-土壤样品风干机-常州索奥仪器制造有限公司 | 物和码官网,物和码,免费一物一码数字化营销SaaS平台 | 无纺布包装机|径向缠绕包装机|缠绕膜打包机-上海晏陵智能设备有限公司 | 篮球地板厂家_舞台木地板品牌_体育运动地板厂家_凯洁地板 | 直流大电流电源,燃料电池检漏设备-上海政飞 | 干粉砂浆设备_干混砂浆生产线_腻子粉加工设备_石膏抹灰砂浆生产成套设备厂家_干粉混合设备_砂子烘干机--郑州铭将机械设备有限公司 | 电动液压篮球架_圆管地埋式篮球架_移动平箱篮球架-强森体育 | 雄松华章(广州华章MBA)官网-专注MBA/MPA/MPAcc/MEM辅导培训 | 永嘉县奥阳陶瓷阀门有限公司 | 芜湖厨房设备_芜湖商用厨具_芜湖厨具设备-芜湖鑫环厨具有限公司 控显科技 - 工控一体机、工业显示器、工业平板电脑源头厂家 | 中医中药治疗血小板减少-石家庄血液病肿瘤门诊部 | 质检报告_CE认证_FCC认证_SRRC认证_PSE认证_第三方检测机构-深圳市环测威检测技术有限公司 | 安徽千住锡膏_安徽阿尔法锡膏锡条_安徽唯特偶锡膏_卡夫特胶水-芜湖荣亮电子科技有限公司 | 捷码低代码平台 - 3D数字孪生_大数据可视化开发平台「免费体验」 | 精密模具制造,注塑加工,吹塑和吹瓶加工,EPS泡沫包装生产 - 济南兴田塑胶有限公司 | 好物生环保网、环保论坛 - 环保人的学习交流平台 | 济南品牌包装设计公司_济南VI标志设计公司_山东锐尚文化传播 | 蔡司三坐标-影像测量机-3D扫描仪-蔡司显微镜-扫描电镜-工业CT-ZEISS授权代理商三本工业测量 | 济南展厅设计施工_数字化展厅策划设计施工公司_山东锐尚文化传播有限公司 | 小型数控车床-数控车床厂家-双头数控车床 |