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

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