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

时间:2021-09-26 00:23:08
  1. '================================================  
  2.     '函数名:ReSaveRemoteFile  
  3.     '作  用:查找文件保存替换  
  4.     '参  数:Str   ----原字符串  
  5.     '参  数:url   ----当然网站URL  
  6.     '参  数:Dir -----保存目录  
  7.     '参  数:InSave ------是否保存,True,False  
  8.     '返回值:格式化取后的字符串  
  9.     '================================================  
  10.     Public Function ReSaveRemoteFile(ByVal str, ByVal URL, ByVal Dir,InSave)  
  11.         Dim s_Content  
  12.         Dim re  
  13.         Dim ContentFile, ContentFileUrl  
  14.         Dim strTempUrl,strFileUrl,DirTemp,PathTemp,FileTemp,Tempi,TempUrlArray,Arr_Path  
  15.         Dim sAllowExtName  
  16.         sAllowExtName="rm|swf"  
  17.  
  18.         s_Content = str  
  19.         On Error Resume Next  
  20.         Set re = New RegExp  
  21.         re.IgnoreCase = True  
  22.         re.Global = True  
  23.         re.Pattern = "((src=|href=)((\S)+[.]{1}(" & sAllowExtName & ")))"  
  24.         Set ContentFile = re.Execute(s_Content)  
  25.         Dim sContentUrl(), n, i, bRepeat  
  26.         n = 0  
  27.         For Each ContentFileUrl In ContentFile  
  28.             strFileUrl = Replace(Replace(Replace(Replace(ContentFileUrl.Value, "src=""", 1, -1, 1), "href=""", 1, -1, 1), "'"""), Chr(34), "")  
  29.             If n = 0 Then  
  30.                 n = n + 1  
  31.                 ReDim sContentUrl(n)  
  32.                 sContentUrl(n) = strFileUrl  
  33.             Else  
  34.                 bRepeat = False  
  35.                 For i = 1 To UBound(sContentUrl)  
  36.                     If UCase(strFileUrl) = UCase(sContentUrl(i)) Then  
  37.                         bRepeat = True  
  38.                         Exit For  
  39.                     End If  
  40.                 Next  
  41.                 If bRepeat = False Then  
  42.                     n = n + 1  
  43.                     ReDim Preserve sContentUrl(n)  
  44.                     sContentUrl(n) = strFileUrl  
  45.                 End If  
  46.             End If  
  47.         Next  
  48.         If n = 0 Then  
  49.             ReSaveRemoteFile = s_Content  
  50.             Exit Function  
  51.         End If  
  52.         For i = 1 To n   
  53.             strTempUrl = sContentUrl(i) : strTempUrl = FormatRemoteUrl(strTempUrl,URL)'得到文件地址  
  54.             Response.Write(strTempUrl)  
  55.             IF InSave=True then  
  56.                 Arr_Path=Split(Dir,"/")  
  57.                 '----------建目录-----------------------  
  58.                   For Tempi=0 To Ubound(Arr_Path)  
  59.                      If Tempi=0 Then  
  60.                         PathTemp=Arr_Path(0) & "/"  
  61.                      ElseIf Tempi=Ubound(Arr_Path) Then  
  62.                         Exit For  
  63.                      Else  
  64.                         PathTemp=PathTemp & Arr_Path(Tempi) & "/"  
  65.                      End If  
  66.                      If CheckDir(PathTemp)=False Then  
  67.                         If MakeNewsDir(PathTemp)=False Then  
  68.                            SaveTf=False  
  69.                            Exit For  
  70.                         End If  
  71.                      End If  
  72.                   Next  
  73.                  '------------------------------------------------------  
  74.                 TempUrlArray=Split(strTempUrl,"/")  
  75.                 '----------检查文件是否存在.如果存在换文件名------------------  
  76.                 Do while True   
  77.                     FileTemp=Dir &  MakeRandom(5) & TempUrlArray(Ubound(TempUrlArray))'生成随机文件名  
  78.                     If CheckFile(FileTemp)=False then  
  79.                         Exit Do  
  80.                     end if  
  81.                 loop   
  82.                 '-------------------------------------------------------------------  
  83.                 Response.Write(FileTemp)  
  84.                 If SaveRemoteFile(FileTemp,strTempUrl)=True then  
  85.                     Response.Write("保存成功")&"<Br>"  
  86.                     s_Content = Replace(s_Content,sContentUrl(i),FileTemp, 1, -1, 1)'替换地址      
  87.                 Else  
  88.                     Response.Write("保存失败")&"<Br>"  
  89.                 End if  
  90.             Else  
  91.                 s_Content = Replace(s_Content,sContentUrl(i),strTempUrl, 1, -1, 1)'替换地址          
  92.             End If      
  93.         Next  
  94.         Set re = Nothing  
  95.         PictureExist = True  
  96.         ReSaveRemoteFile = s_Content  
  97.         Exit Function  
  98.     End Function