URL을 사용하여 이미지를 빠르고 효율적으로 가져 오는 방법은 무엇입니까?

Question

MSXML을 사용하고 바이너리로 가져올 수 있습니까? 아니면 또 다른 효율적인 방법이 있습니까?

가져올 JPEG의 공연 및 공연이 있습니다.

Answer 1

나는 과거에 뭔가를 작성 했으므로 아래 코드는 서버 이미지에 원격 이미지를 저장합니다. 그것은 꽤 효율적 고전적인 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 파일과 같은 위치에 있습니다.

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 

Answer 2

다운로드 스크립트 파일을 저장하는 방법의 요점이다? 또한, * classic * ASP? 진짜야? MSXML (XMLHttpRequest)의 큰 문제는 * 동시 연결 수를 제한한다는 것입니다. 사실 XMLHTTPServerRequest는 다른 규칙을 가지고 있지만 실제로 병렬 다운로드를 죽일 것인가? 스트림 크기에 한계가 있으며 노출되지 않은 IStream을 사용해야한다고 생각합니다.