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