源码网商城,靠谱的源码在线交易网站 我的订单 购物车 帮助

源码网商城

ReSaveRemoteFile函数之asp实现查找文件保存替换的代码

  • 时间:2020-08-02 09:52 编辑: 来源: 阅读:
  • 扫一扫,手机访问
摘要:ReSaveRemoteFile函数之asp实现查找文件保存替换的代码
'================================================     '函数名:ReSaveRemoteFile     '作  用:查找文件保存替换     '参  数:Str   ----原字符串     '参  数:url   ----当然网站URL     '参  数:Dir -----保存目录     '参  数:InSave ------是否保存,True,False     '返回值:格式化取后的字符串     '================================================     Public Function ReSaveRemoteFile(ByVal str, ByVal URL, ByVal Dir,InSave)         Dim s_Content         Dim re         Dim ContentFile, ContentFileUrl         Dim strTempUrl,strFileUrl,DirTemp,PathTemp,FileTemp,Tempi,TempUrlArray,Arr_Path         Dim sAllowExtName         sAllowExtName="rm|swf"         s_Content = str         On Error Resume Next         Set re = New RegExp         re.IgnoreCase = True         re.Global = True         re.Pattern = "((src=|href=)((\S)+[.]{1}(" & sAllowExtName & ")))"         Set ContentFile = re.Execute(s_Content)         Dim sContentUrl(), n, i, bRepeat         n = 0         For Each ContentFileUrl In ContentFile             strFileUrl = Replace(Replace(Replace(Replace(ContentFileUrl.Value, "src=", "", 1, -1, 1), "href=", "", 1, -1, 1), "'", ""), Chr(34), "")             If n = 0 Then                 n = n + 1                 ReDim sContentUrl(n)                 sContentUrl(n) = strFileUrl             Else                 bRepeat = False                 For i = 1 To UBound(sContentUrl)                     If UCase(strFileUrl) = UCase(sContentUrl(i)) Then                         bRepeat = True                         Exit For                     End If                 Next                 If bRepeat = False Then                     n = n + 1                     ReDim Preserve sContentUrl(n)                     sContentUrl(n) = strFileUrl                 End If             End If         Next         If n = 0 Then             ReSaveRemoteFile = s_Content             Exit Function         End If         For i = 1 To n              strTempUrl = sContentUrl(i) : strTempUrl = FormatRemoteUrl(strTempUrl,URL)'得到文件地址             Response.Write(strTempUrl)             IF InSave=True then                 Arr_Path=Split(Dir,"/")                 '----------建目录-----------------------                   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                  '------------------------------------------------------                 TempUrlArray=Split(strTempUrl,"/")                 '----------检查文件是否存在.如果存在换文件名------------------                 Do while True                      FileTemp=Dir &  MakeRandom(5) & TempUrlArray(Ubound(TempUrlArray))'生成随机文件名                     If CheckFile(FileTemp)=False then                         Exit Do                     end if                 loop                  '-------------------------------------------------------------------                 Response.Write(FileTemp)                 If SaveRemoteFile(FileTemp,strTempUrl)=True then                     Response.Write("保存成功")&"<Br>"                     s_Content = Replace(s_Content,sContentUrl(i),FileTemp, 1, -1, 1)'替换地址                     Else                     Response.Write("保存失败")&"<Br>"                 End if             Else                 s_Content = Replace(s_Content,sContentUrl(i),strTempUrl, 1, -1, 1)'替换地址                     End If             Next         Set re = Nothing         PictureExist = True         ReSaveRemoteFile = s_Content         Exit Function     End Function
  • 全部评论(0)
联系客服
客服电话:
400-000-3129
微信版

扫一扫进微信版
返回顶部