开发者

What is a fast and efficient way to import images by URL?

开发者 https://www.devze.com 2023-03-31 00:53 出处:网络
Would I just use MSXML开发者_如何学运维 and import as binary? Or is there another more efficient way?

Would I just use MSXML开发者_如何学运维 and import as binary? Or is there another more efficient way?

There are gigs and gigs of JPEGs to fetch.


I have written something in the past, the code below will save remote image on the server disk. It's classic ASP and pretty efficient:

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

Just call SaveOnServer sub routine passing the URL and desired file name, you can also omit the file name and in that case, the file name will be taken from the URL itself.
The server folder is defined as constant and will be in the same place as .asp file.


Here is the gist of how to download and save files in 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
0

精彩评论

暂无评论...
验证码 换一张
取 消

关注公众号