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

Question

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.

Answer 1

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.

Answer 2

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