ADODB.Stream을 이용한 다운로드,파일저장

<%
'Load a file from disk
Function LoadStream(FilePath)
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1 'adTypeBinary=1
objStream.Open
objStream.LoadFromFile FilePath
LoadStream = objStream.Read
objStream.Close
Set objStream = Nothing
End Function

'Load a file from url
Function LoadStreamUrl(FilePath)
Dim objXmlHttp, imgData
Set objXmlHttp = createobject("Microsoft.XMLHTTP")
objXmlHttp.open "get",FilePath,false
objXmlHttp.send()

imgData = objXmlHttp.responseBody
Set objXmlHttp = nothing

LoadStreamUrl = imgData

'파일을 웹서버에 저장하고싶으면 아래를 활성화

'Set objStream = CreateObject("ADODB.Stream")
'objStream.Open()
'objStream.Type = 1
'objStream.Write imgData
'objStream.SaveToFile fPath & "" & FileName &"."& TailName,2
'Set objStream = nothing
End Function

'returns the MIME header type for a given extension
Function GetMIMEType(Extension)
dim Ext
Ext = UCase(Extension)
select case Ext 'Common documents
case "TXT", "TEXT", "JS", "VBS", "ASP", "CGI", "PL", "NFO", "ME", "DTD"
sMIME = "text/plain"
case "HTM", "HTML", "HTA", "HTX", "MHT"
sMIME = "text/html"
case "CSV"
sMIME = "text/comma-separated-values"
case "JS"
sMIME = "text/javascript"
case "CSS"
sMIME = "text/css"
case "PDF"
sMIME = "application/pdf"
case "RTF"
sMIME = "application/rtf"
case "XML", "XSL", "XSLT"
sMIME = "text/xml"
case "WPD"
sMIME = "application/wordperfect"
case "WRI"
sMIME = "application/mswrite"
case "XLS", "XLS3", "XLS4", "XLS5", "XLW"
sMIME = "application/msexcel"
case "DOC"
sMIME = "application/msword"
case "PPT","PPS"
sMIME = "application/mspowerpoint"
'WAP/WML files
case "WML"
sMIME = "text/vnd.wap.wml"
case "WMLS"
sMIME = "text/vnd.wap.wmlscript"
case "WBMP"
sMIME = "image/vnd.wap.wbmp"
case "WMLC"
sMIME = "application/vnd.wap.wmlc"
case "WMLSC"
sMIME = "application/vnd.wap.wmlscriptc"
'Images
case "GIF"
sMIME = "image/gif"
case "JPG", "JPE", "JPEG"
sMIME = "image/jpeg"
case "PNG"
sMIME = "image/png"
case "BMP"
sMIME = "image/bmp"
case "TIF","TIFF"
sMIME = "image/tiff"
case "AI","EPS","PS"
sMIME = "application/postscript"
'Sound files
case "AU","SND"
sMIME = "audio/basic"
case "WAV"
sMIME = "audio/wav"
case "RA","RM","RAM"
sMIME = "audio/x-pn-realaudio"
case "MID","MIDI"
sMIME = "audio/x-midi"
case "MP3"
sMIME = "audio/mp3"
case "M3U"
sMIME = "audio/m3u"
'Video/Multimedia files
case "ASF"
sMIME = "video/x-ms-asf"
case "AVI"
sMIME = "video/avi"
case "MPG","MPEG"
sMIME = "video/mpeg"
case "QT","MOV","QTVR"
sMIME = "video/quicktime"
case "SWA"
sMIME = "application/x-director"
case "SWF"
sMIME = "application/x-shockwave-flash"
'Compressed/archives
case "ZIP"
sMIME = "application/x-zip-compressed"
case "GZ"
sMIME = "application/x-gzip"
case "RAR"
sMIME = "application/x-rar-compressed"
'Miscellaneous
case "COM","EXE","DLL","OCX"
sMIME = "application/octet-stream"
'Unknown (send as binary stream)
case else
sMIME = "application/octet-stream"
end select
GetMimeType = sMIME
End Function

'Sends the specified file to the browser
sub SendStreamToBrowser(FileStream, FileName, ContentType, IsInline)
Dim FileExt, FileSize
'Disable error checking
on error resume next
'Clear buffer
Response.Clear
FileExt = mid(FileExt, instrrev(FileName,".") + 1)
FileSize = Ubound(FileStream) + 1
'Add filename to header
Response.AddHeader "Connection", "keep-alive"
Response.AddHeader "Content-Length", FileSize
'Check if data should be delivered inline or not
If IsInline = True then
'Allow the browser to render the file inside a browser window (if it can)
Response.AddHeader "Content-Disposition","inline; filename=" & FileName
Else
'Force browser to save file
Response.AddHeader "Content-Disposition","attachment; filename=""" & FileName & """"
End If
'Get ContentType for download
select case ContentType
case false
'Generic binary ContentType and Charset
Response.ContentType = "application/octet-stream"
Response.Charset = "UTF-8"
case ""
'Find out what it should be
Response.ContentType = GetMIMEType(FileExt)
case else
'Use the ContentType that was passed
Response.ContentType = ContentType
end select
'Send data to client
Response.BinaryWrite(FileStream)
Response.Flush
End Sub

 

Sub App(sourceUrl, targetUrl, charset)
 targetUrl = Replace(targetUrl, "<#charset#>", charset)

 Dim WinHttpReq, strHttpReq
 Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
 WinHttpReq.SetTimeouts 30000, 30000, 30000, 30000
 WinHttpReq.Open "GET", sourceUrl, False
 WinHttpReq.Send
 WinHttpReq.WaitForResponse
 strHttpReq = WinHttpReq.ResponseText
 Set WinHttpReq = Nothing

 If InStr(strHttpReq, "<!--ERROR-->") > 0 Or InStr(strHttpReq, "Service Unavailable") > 0 Then
  Call WriteLog(targetUrl)
  Exit Sub
 End If

 Dim objStream
 Set objStream = CreateObject("ADODB.Stream")
 objStream.Mode = 3
 objStream.Type = 2 ' adTypeText
 If charset = "ansi" Then
  objStream.CharSet = "euc-kr"
 ElseIf charset = "utf8" Then
  objStream.CharSet = "utf-8"
 End If
 objStream.Open
 objStream.WriteText strHttpReq
 objStream.SaveToFile targetUrl, 2
 objStream.Flush
 objStream.Close
 Set objStream = Nothing
End Sub
 
'CALL SendStreamToBrowser(LoadStreamUrl("http://sstatic.naver.net/search/img2/logo_naver_2.gif"),"logo_naver_2.gif","",True)
%>