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