Wininet을 통한 다운로드 예제

이번엔 콜백함수까지 넣어봤어요...

클래스로 만들려 했으나 제 실력이 부족한 탓에 ㅋㅋ...

별 대단한것도 없으니까 공부용으로만 사용하세요 ㄷㄷ

'====================================================
'
' 바람개비(cjh9217)
' http://blog.naver.com/cjh9217
'
' szURL     : 목표 URL
' ReturnByte : 받아온 데이터를 저장할 버퍼
' szHeader : 추가로 보낼 헤더
'
' Return     : 성공시 True, 실패시 False
'
'====================================================

Public Function InternetDownload(ByRef szURL As String, _
                                        ByRef ReturnByte() As Byte, _
                                        Optional ByRef szHeader As String = vbNullString _
                                        ) As Boolean
On Error Goto UnExpectedErr

     Dim hOpen As Long, Ret As Long
    
     hOpen = InternetOpen("HTTPTEST", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
     If hOpen = 0& Then Goto DownloadErr
    
     Ret = InternetOpenUrl(hOpen, szURL, szHeader, CLng(IIf(Len(szHeader), Len(szHeader) + 1&, 0&)), INTERNET_FLAG_RELOAD, ByVal 0&)
     If Ret = 0& Then Goto DownloadErr
    
     Dim Buffer As String, SizeBuf As Long, ContentLength As Long
     Buffer = String$(1024, 0)
     SizeBuf = Len(Buffer)
    
     '--- 파일 크기를 알아온다.
     '--- if 못알아 올시 그냥 패스
     If HttpQueryInfo(Ret, HTTP_QUERY_CONTENT_LENGTH, ByVal Buffer, SizeBuf, ByVal 0&) Then
          ContentLength = CLng(Left$(Buffer, SizeBuf))
     End If
    
     Call CallBackDataSize(ContentLength)

     Dim lngBufSize As Long, sBuf() As Byte, lngRet As Long, TotalBuffer() As Byte, i As Long
    
     '### 이제부터 데이터를 받아온다
     Do
          Call InternetQueryDataAvailable(Ret, lngBufSize, 0&, 0&)

          If lngBufSize Then
               ReDim sBuf(lngBufSize - 1)
               Call InternetReadFile(Ret, sBuf(0), lngBufSize, lngRet)
              
               Call CallBackDownloadFunc(sBuf)
              
               i = i + UBound(sBuf) + 1
               ReDim Preserve TotalBuffer(i - 1)
               RtlMoveMemory TotalBuffer(i - UBound(sBuf) - 1), sBuf(0), UBound(sBuf) + 1&
          Else
               Exit Do
          End If
         
          DoEvents
     Loop
    
     ReturnByte = TotalBuffer
    
     Erase sBuf
     Erase TotalBuffer
     Call InternetCloseHandle(hOpen)
    
     InternetDownload = True
     Exit Function
    
DownloadErr:
     Call InternetCloseHandle(hOpen)
     Exit Function
UnExpectedErr:
     MsgBox "예상하지 못한 오류가 발생하였습니다." & vbCrLf & "에러번호 (" & Err.Number & ") " & Err.Description, vbCritical
     Exit Function

End Function

'### 콜백함수로 지정된 함수입니다.
'### Data : 현재 받아온 데이타
Private Sub CallBackDownloadFunc(Data() As Byte)
    
     If FileSize Then
          GetData = GetData + UBound(Data) + 1
          With Form1
               .lbProgress.Width = CLng(GetData / FileSize * PicWidth)
               .Label3.Caption = CLng(.lbProgress.Width / PicWidth * 100) & "%"
          End With
     End If
    
End Sub

Private Sub CallBackDataSize(ByVal DataLength As Long)
     FileSize = DataLength
     GetData = 0&
     Form1.lbProgress.Width = 0&
     Form1.Label3.Caption = "다운로드 준비중..."
End Sub