Что такое быстрый и эффективный способ импорта изображений по URL? - PullRequest
Новая
       51

Что такое быстрый и эффективный способ импорта изображений по URL?

1 голос
/ 28 августа 2011

Буду ли я просто использовать MSXML и импортировать как бинарный файл?Или есть другой, более эффективный способ?

Для просмотра доступны концерты в формате JPEG.

Ответы [ 2 ]

1 голос
/ 28 августа 2011

Я написал что-то в прошлом, код ниже сохранит удаленный образ на диске сервера. Это классический ASP и довольно эффективный: 

<% 
Const CONTENT_FOLDER_NAME = "StoredContents"
Dim strImageUrl
strImageUrl = "http://www.gravatar.com/avatar/8c488f9c3d3da5bb756507179a3d53fd?s=32&d=identicon&r=PG"

Call SaveOnServer(strImageUrl, "bill_avatar.jpg")

Sub SaveOnServer(url, strFileName)
    Dim strRawData, objFSO, objFile
    Dim strFilePath, strFolderPath, strError

    strRawData = GetBinarySource(url, strError)
    If Len(strError)>0 Then
        Response.Write("<span style=""color: red;"">Failed to get binary source. Error:<br />" & strError & "</span>")
    Else  
        strFolderPath = Server.MapPath(CONTENT_FOLDER_NAME)
        Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
        If Not(objFSO.FolderExists(strFolderPath)) Then
            objFSO.CreateFolder(strFolderPath)
        End If

        If Len(strFileName)=0 Then
            strFileName = GetCleanName(url)
        End If

        strFilePath = Server.MapPath(CONTENT_FOLDER_NAME & "/" & strFileName)
        Set objFile = objFSO.CreateTextFile(strFilePath)
        objFile.Write(RSBinaryToString(strRawData))
        objFile.Close
        Set objFile = Nothing
        Set objFSO = Nothing

        Response.Write("<h3>Stored contents of " & url & ", total of <span style=""color: blue;"">" & LenB(strRawData) & "</span> bytes</h3>")
        Response.Write("<a href=""" & CONTENT_FOLDER_NAME & "/" & strFileName & """ target=""_blank""><span style=""color: blue;"">" &_
            strFileName & "</span></a>")
    End If
End Sub

Function RSBinaryToString(xBinary)
    ''# Antonin Foller, http://www.motobit.com
    ''# RSBinaryToString converts binary data (VT_UI1 | VT_ARRAY Or MultiByte string)
    ''# to a string (BSTR) using ADO recordset

    Dim Binary
    '' #MultiByte data must be converted To VT_UI1 | VT_ARRAY first.
    If vartype(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary

    Dim RS, LBinary
    Const adLongVarChar = 201
    Set RS = CreateObject("ADODB.Recordset")
    LBinary = LenB(Binary)

    If LBinary>0 Then
        RS.Fields.Append "mBinary", adLongVarChar, LBinary
        RS.Open
        RS.AddNew
        RS("mBinary").AppendChunk Binary 
        RS.Update
        RSBinaryToString = RS("mBinary")
    Else  
        RSBinaryToString = ""
    End If
End Function

Function MultiByteToBinary(MultiByte)
    ''# © 2000 Antonin Foller, http://www.motobit.com
    ''# MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY)
    ''# Using recordset
    Dim RS, LMultiByte, Binary
    Const adLongVarBinary = 205
    Set RS = CreateObject("ADODB.Recordset")
    LMultiByte = LenB(MultiByte)
    If LMultiByte>0 Then
        RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
        RS.Open
        RS.AddNew
        RS("mBinary").AppendChunk MultiByte & ChrB(0)
        RS.Update
        Binary = RS("mBinary").GetChunk(LMultiByte)
    End If
    MultiByteToBinary = Binary
End Function

Function GetBinarySource(url, ByRef strError)
    Dim objXML
    Set objXML=Server.CreateObject("Microsoft.XMLHTTP")
    GetBinarySource=""
    strError = ""
    On Error Resume Next
        objXML.Open "GET", url, False
        objXML.Send
        If Err.Number<>0 Then
            Err.Clear
            Set objXML = Server.CreateObject("MSXML2.ServerXMLHTTP")
            objXML.Open "GET", url, False
            objXML.Send
            If Err.Number<>0 Then
                strError = "Error " & Err.Number & ": " & Err.Description
                Err.Clear
                Exit Function
            End If
         End If
    On Error Goto 0
    GetBinarySource=objXML.ResponseBody
    Set objXML=Nothing
End Function

Function GetCleanName(s)
    Dim result, x, c
    Dim arrTemp

    arrTemp = Split(s, "/")
    If UBound(arrTemp)>0 Then
        For x=0 To UBound(arrTemp)-1
            result = result & GetCleanName(arrTemp(x)) & "_"
        Next
        result = result & GetPageName(s)
    Else  
        For x=1 To Len(s)
            c = Mid(s, x, 1)
            If IsValidChar(c) Then
                result = result & c
            Else  
                result = result & "_"
            End If
        Next
    End If
    Erase arrTemp
    GetCleanName = result
End Function

Function IsValidChar(c)
    IsValidChar = (c >= "a" And c <= "z") Or (c >= "A" And c <= "Z") Or (IsNumeric(c))
End Function


Function GetPageName(strUrl)
    If Len(strUrl)>0 Then
        GetPageName=Mid(strUrl, InStrRev(strUrl, "/")+1, Len(strUrl))
    Else  
        GetPageName=""
    End If
End Function
%>

Просто вызовите подпрограмму SaveOnServer, передав URL-адрес и желаемое имя файла, вы также можете опустить имя файла, и в этом случае имя файла будет взято из самого URL-адреса. Папка сервера определена как постоянная и будет в том же месте, что и файл .asp.

0 голосов
/ 28 августа 2011

Вот суть того, как скачивать и сохранять файлы в скрипте: - 

 Function DownloadAndSave(sourceUrl, destinationFile)

     Dim req : Set req = CreateObject("WinHttp.WinHttpRequest.5.1")
     req.Open "GET", sourceUrl, false
     req.Send

     Dim stream : Set stream = CreateObject("ADODB.Stream")
     stream.Type = 1 ''# adTypeBinary
     stream.Open
     stream.Write req.ResponseBody
     stream.SaveToFile destinationFile, 2
     stream.Close

 End Function
...