powereasy.xmlhttp.asp

个人网站比较简短

                    If AddWatermark = True Then
                        Call PE_Thumb.AddWatermark(SaveFilePath & SaveFileName)
                    End If
                    Set PE_Thumb = Nothing
                End If

                If IsThumb = True Then
                    UploadFiles = SavePath2 & ThumbFileName & "|" & SavePath2 & SaveFileName
                Else
                    If UploadFiles = "" Then
                        UploadFiles = SavePath2 & SaveFileName
                    Else
                        UploadFiles = UploadFiles & "|" & SavePath2 & SaveFileName
                    End If
                End If
                If PE_CLng(Trim(Request.Form("IncludePic"))) = 0 Then
                    If FileCount > 0 Then
                        IncludePic = 2
                    Else
                        IncludePic = 1
                    End If
                Else
                    IncludePic = PE_CLng(Trim(Request.Form("IncludePic")))
                End If

                If InStr(UploadFiles, "|") = 0 Then
                    DefaultPicUrl = UploadFiles
                Else
                    FilesArray = Split(UploadFiles, "|")
                    DefaultPicUrl = FilesArray(0)
                End If
                FileCount = FileCount + 1
            End If
            tempi = tempi + 1
            Response.Write "·"
            Response.Flush
        End If
    Next
    If FileCount > 0 Then Response.Write " <b><font color='blue'>共成功保存了 " & FileCount & " 张远程图片！</font></b><br>"
    ReplaceRemoteUrl = strContent
End Function

'==================================================
'函数名：SaveRemoteFile
'作  用：保存远程的文件到本地
'参  数：LocalFileName ------ 本地文件名
'        RemoteFileUrl ------ 远程文件URL
'返回值：True ----- 保存成功
'       False ----- 保存失败
'==================================================
Function SaveRemoteFile(RemoteFileUrl, LocalFileName)
    On Error Resume Next

    Dim Ads, Retrieval, GetRemoteData
    Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
    With Retrieval
        .Open "Get", RemoteFileUrl, False, "", ""
        .Send
        GetRemoteData = .ResponseBody
    End With
    If Err.Number <> 0 Then
        Err.Clear
        Response.Write "<br>" & RemoteFileUrl & " Get Failed"
        SaveRemoteFile = False
        Exit Function
    End If
    Set Retrieval = Nothing
    Set Ads = Server.CreateObject("Adodb.Stream")
    With Ads
        .Type = 1
        .Open
        .Write GetRemoteData
        .SaveToFile Server.MapPath(LocalFileName), 2
        .Cancel
        .Close
    End With
    Set Ads = Nothing
    If Err.Number <> 0 Then
        Err.Clear
        Response.Write "<br>" & LocalFileName & " Save Failed"
        SaveRemoteFile = False
    Else
        SaveRemoteFile = True
    End If
End Function

'=================================================
'方法名：ReplaceStringPath()
'作  用：区域采集内容连接替换
'=================================================
Function ReplaceStringPath(ByVal AreaCode, ByVal AreaUrl, ByVal UpFileType)
    If IsNull(AreaCode) = True Then
        ReplaceStringPath = ""
    End If
    Dim strTemp, strTemp2, strTemp3
    
    regEx.Pattern = "(value|src|href)(\s*=)(.[^\<]*)(\.)(" & UpFileType & ")"
    Set Matches = regEx.Execute(AreaCode)
    For Each Match In Matches
        regEx.Pattern = "(value|src|href)(\s*=)"
        Set strTemp = regEx.Execute(Match.value)
        For Each Match2 In strTemp
            strTemp2 = Match2.value
        Next
        regEx.Pattern = "(value|src|href)(\s*=)"
        strTemp = regEx.Replace(Match.value, "")
    
        If Left(strTemp, 1) = "'" Then
            strTemp3 = "'"
        ElseIf Left(strTemp, 1) = """" Then
            strTemp3 = """"
        End If
        strTemp = regEx.Replace(strTemp, "")
        strTemp = Replace(strTemp, """", "")
        strTemp = Replace(strTemp, "'", "")
        AreaCode = Replace(AreaCode, Match.value, strTemp2 & strTemp3 & DefiniteUrl(strTemp, AreaUrl))
    Next
    ReplaceStringPath = AreaCode
End Function

'==================================================
'函数名：DefiniteUrl
'作  用：将相对地址转换为绝对地址
'参  数：PrimitiveUrl ------要转换的相对地址
'参  数：ConsultUrl ------当前网页地址
'==================================================
Function DefiniteUrl(ByVal PrimitiveUrl, ByVal ConsultUrl)
    Dim ConTemp, PriTemp, Pi, Ci, PriArray, ConArray
    If PrimitiveUrl = "" Or ConsultUrl = "" Or PrimitiveUrl = "$False$" Or ConsultUrl = "$False$" Then
        DefiniteUrl = "$False$"
        Exit Function
    End If
    If Left(LCase(ConsultUrl), 7) <> "http://" Then
        ConsultUrl = "http://" & ConsultUrl
    End If
    ConsultUrl = Replace(ConsultUrl, "\", "/")
    ConsultUrl = Replace(ConsultUrl, "://", ":\\")
    PrimitiveUrl = Replace(PrimitiveUrl, "\", "/")
   
    If Right(ConsultUrl, 1) <> "/" Then
        If InStr(ConsultUrl, "/") > 0 Then
            If InStr(Right(ConsultUrl, Len(ConsultUrl) - InStrRev(ConsultUrl, "/")), ".") > 0 Then
            Else
                ConsultUrl = ConsultUrl & "/"
            End If
        Else
            ConsultUrl = ConsultUrl & "/"
        End If
    End If
    ConArray = Split(ConsultUrl, "/")

    If Left(LCase(PrimitiveUrl), 7) = "http://" Then
        DefiniteUrl = Replace(PrimitiveUrl, "://", ":\\")
    ElseIf Left(PrimitiveUrl, 1) = "/" Then
        DefiniteUrl = ConArray(0) & PrimitiveUrl
    ElseIf Left(PrimitiveUrl, 2) = "./" Then
        PrimitiveUrl = Right(PrimitiveUrl, Len(PrimitiveUrl) - 2)
        If Right(ConsultUrl, 1) = "/" Then
            DefiniteUrl = ConsultUrl & PrimitiveUrl
        Else
            DefiniteUrl = Left(ConsultUrl, InStrRev(ConsultUrl, "/")) & PrimitiveUrl
        End If
    ElseIf Left(PrimitiveUrl, 3) = "../" Then
        Do While Left(PrimitiveUrl, 3) = "../"
            PrimitiveUrl = Right(PrimitiveUrl, Len(PrimitiveUrl) - 3)
            Pi = Pi + 1
        Loop
        For Ci = 0 To (UBound(ConArray) - 1 - Pi)
            If DefiniteUrl <> "" Then
                DefiniteUrl = DefiniteUrl & "/" & ConArray(Ci)
            Else
                DefiniteUrl = ConArray(Ci)
            End If
        Next
        DefiniteUrl = DefiniteUrl & "/" & PrimitiveUrl
    Else
        If InStr(PrimitiveUrl, "/") > 0 Then
            PriArray = Split(PrimitiveUrl, "/")
            If InStr(PriArray(0), ".") > 0 Then
                If Right(PrimitiveUrl, 1) = "/" Then
                    DefiniteUrl = "http:\\" & PrimitiveUrl
                Else
                    If InStr(PriArray(UBound(PriArray) - 1), ".") > 0 Then
                        DefiniteUrl = "http:\\" & PrimitiveUrl
                    Else
                        DefiniteUrl = "http:\\" & PrimitiveUrl & "/"
                    End If
                End If
            Else
                If Right(ConsultUrl, 1) = "/" Then
                    DefiniteUrl = ConsultUrl & PrimitiveUrl
                Else
                    DefiniteUrl = Left(ConsultUrl, InStrRev(ConsultUrl, "/")) & PrimitiveUrl
                End If
            End If
        Else
            If InStr(PrimitiveUrl, ".") > 0 Then
                If Right(ConsultUrl, 1) = "/" Then
                    If Right(LCase(PrimitiveUrl), 3) = ".cn" Or Right(LCase(PrimitiveUrl), 3) = "com" Or Right(LCase(PrimitiveUrl), 3) = "net" Or Right(LCase(PrimitiveUrl), 3) = "org" Then
                        DefiniteUrl = "http:\\" & PrimitiveUrl & "/"
                    Else
                        DefiniteUrl = ConsultUrl & PrimitiveUrl
                    End If
                Else
                    If Right(LCase(PrimitiveUrl), 3) = ".cn" Or Right(LCase(PrimitiveUrl), 3) = "com" Or Right(LCase(PrimitiveUrl), 3) = "net" Or Right(LCase(PrimitiveUrl), 3) = "org" Then
                        DefiniteUrl = "http:\\" & PrimitiveUrl & "/"
                    Else
                        DefiniteUrl = Left(ConsultUrl, InStrRev(ConsultUrl, "/")) & "/" & PrimitiveUrl
                    End If
                End If
            Else
                If Right(ConsultUrl, 1) = "/" Then
                    DefiniteUrl = ConsultUrl & PrimitiveUrl & "/"
                Else
                    DefiniteUrl = Left(ConsultUrl, InStrRev(ConsultUrl, "/")) & "/" & PrimitiveUrl & "/"
                End If
            End If
        End If
    End If
    If Left(DefiniteUrl, 1) = "/" Then
        DefiniteUrl = Right(DefiniteUrl, Len(DefiniteUrl) - 1)
    End If
    If DefiniteUrl <> "" Then
        DefiniteUrl = Replace(DefiniteUrl, "//", "/")
        DefiniteUrl = Replace(DefiniteUrl, ":\\", "://")
    Else
        DefiniteUrl = "$False$"
    End If
End Function

%>