¿Cuál es una forma rápida y eficiente de importar imágenes por URL?

¿Usaría MSXML e importaría como binario? ¿O hay otra forma más eficiente?

Hay conciertos y conciertos de JPEG para buscar.

preguntado el 27 de agosto de 11 a las 22:08

"importar" siendo "descargar"? También, clásico ¿ÁSPID? ¿De verdad? Siento tu dolor :( Podría valer la pena buscar más ... soluciones ... modernas. A a lo grande problema con MSXML (XMLHttpRequest) es que limitar el número de conexiones simultáneas (probablemente 2) ¿cuál eliminará efectivamente la descarga paralela, aunque quizás XMLHTTPServerRequest tenga reglas diferentes? Creo que también hay límites con el tamaño de la transmisión y la necesidad de usar los métodos expuestos IStream, con los que no he jugado. -

soluciones modernas como? .¿NETO? Necesita buscar, cambiar el tamaño / recortar y guardar la imagen en el disco desde la URL -

@Bill: descargar y guardar bastante fácil usando WinHTTPRequest y ADODB.Stream pero "redimensionar / recortar" bueno, eso es una bola de cera completamente diferente. -

2 Respuestas

He escrito algo en el pasado, el siguiente código guardará la imagen remota en el disco del servidor. Es ASP clásico y bastante eficiente:

<% 
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
%>

Solo llama SaveOnServer subrutina que pasa la URL y el nombre del archivo deseado, también puede omitir el nombre del archivo y, en ese caso, el nombre del archivo se tomará de la propia URL.
La carpeta del servidor se define como constante y estará en el mismo lugar que .asp archivo.

Respondido 28 ago 11, 23:08

Tenga en cuenta el estándar XmlHttp El objeto no debe usarse en código ASP, siempre use ServerXmlHttp o realmente en este caso el subyacente WinHttpRequest haría. - AnthonyWJones

Gracias @Anthony, pero ¿por qué no? ¿Cuáles son los riesgos? - Shadow Wizard está vacunado V3

El xmlHttp estándar usa la pila HTTP de cliente estándar (WinInet) que no espera usarse de esta manera. En particular, algunas operaciones no son seguras para subprocesos. La pila WinHTTP está diseñada para ser mucho más delgada para su uso en escenarios de servidor. - AnthonyWJones

Aquí está la esencia de cómo descargar y guardar archivos en un script: -

 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

Respondido 28 ago 11, 23:08

No es la respuesta que estás buscando? Examinar otras preguntas etiquetadas or haz tu propia pregunta.