'================================================ '函数名：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
