'-- 제작자 : 축복(q_death) @ Naver
'-- 홈페이지 : http://www.svkor.com
'-- E-Mail : q_death@naver.com
'--
'-- 함수명 : FileDownload
'-- 파라미터
'-- - strURL : 웹상의 파일 주소
'-- - strLocalPath : 파일이 저장될 경로
'-- - isBinary : 파일의 형식이 바이너리인지 여부
Option Explicit
Public Function FileDownload(ByRef strURL As String, _
ByRef Optional strLocalPath As String = vbNullString, _
ByRef Optional isBinary As Boolean =True) As Boolean
On Error Goto OnErr
Dim oWinHttp As Object
Set oWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
With oWinHttp
.Open "GET", strURL, False
.Send
If LenB(strLocalPath) = 0& Then
Dim Temp As String
Temp = .getresponseheader("Content-Disposition")
Dim Pos As Long
Pos = InStr(Temp, "filename=""")
If Pos = 0& Then
Goto OnErr
End If
Pos = Pos + 10&
Temp = Mid$(Temp, Pos, Len(Temp) - Pos)
Temp = Replace$(Temp, "_", " ")
Dim FileName As String
FileName = Temp
strLocalPath = App.Path & "\Incoming\" & FileName
If LenB(Dir$(App.Path & "\Incoming", vbDirectory)) = 0& Then
MkDir App.Path & "\Incoming"
End If
End If
Dim Buf() As Byte
If isBinary Then
Buf = .ResponseBody
Else
Buf = .ResponseText
End If
Open strLocalPath For Binary Access Write As #1
Put #1, , Buf
Close #1
End With
If Not oWinHttp Is Nothing Then
Set oWinHttp = Nothing
End If
FileDownload = True
Exit Function
OnErr:
If Err Then
If Err.Number = 0& Then
MsgBox "파일을 다운로드 하는 중, 알 수 없는 오류가 발생하였습니다.", vbExclamation Or vbApplicationModal
Else
MsgBox "파일을 다운로드 하는 중, 오류가 발생하였습니다. (" & Err.Number & ")" & vbCrLf & _
Error(Err.Number), vbExclamation Or vbApplicationModal
End If
Err.Clear
End If
End Function
'Download'에 해당되는 글 1건
- 2011/09/28 [VB6] WinHttp를 이용한 FileDownload 소스
Posted on 2011/09/28 00:59 Url http://www.svkor.com/blog/13
Filed Under 프로그래밍/Visual Basic
[VB6] WinHttp를 이용한 FileDownload 소스
