Option Explicit

'// NOT RECOMMENDED FOR LARGE DOWNLOADS

Private Const MAX_BUFFER_LENGTH = 8162
Private Const API_AGENT_NAME As String = "VB Program"
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000

Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_HIDEWINDOW = &H80
Private Const SW_SHOWNORMAL = 1
Private Const WM_CLOSE = &H10


Private Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Declare Function APIBeep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByRef hInet As Long) As Long
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuff As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long

Private m_StopWatch As Long

Private Sub DownloadAPIProgress(ByVal sUrl As String, ByRef dData As Double, _
    Optional ByVal sFolder As String, Optional ByRef frm As Form)
    Dim hOpen As Long, hFile As Long, Ret As Long, bForm As Boolean
    Dim sBuff As String * MAX_BUFFER_LENGTH, sData As String
    Dim sFileName As String, iFile As Integer, lSize As Long
    If InStr(1, sUrl, "/") Then
        sFileName = Right$(sUrl, Len(sUrl) - InStrRev(sUrl, "/"))
    Else
        sFileName = "Download" & Format(Now, "hhmmssmmddyy") & ".tmp"
    End If
    If Not IsMissing(sFolder) And Len(sFileName) Then
        If Len(Dir$(App.Path & "\" & sFolder)) Then
            sFileName = App.Path & "\" & sFolder & sFileName
        Else
            dData = 0: Exit Sub
        End If
    Else
        dData = 0: Exit Sub
    End If
    If Not IsMissing(frm) Then bForm = True
    '// Debug.Print sFileName
    If bForm Then
        frm.Label1 = "Connecting ... "
        frm.Label1.Refresh
        frm.Label3.Refresh
    End If
    hOpen = InternetOpen(API_AGENT_NAME, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    If hOpen = 0 Then
        MsgBox "Error opening Internet connection"
        Exit Sub
    End If
    hFile = InternetOpenUrl(hOpen, sUrl, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
    If hFile = 0 Then
        dData = 0
    Else
        APIBeep 1500, 100
        APIBeep 1800, 200
        StartTimer
        If bForm Then
            frm.Label1 = "Downloading ... " & Format(Len(sData) / 1024, 0) & " KB"
            frm.Label3 = " " & FormatNumber(StopTimer, 0)
            frm.Label1.Refresh
            frm.Label3.Refresh
        End If
        InternetReadFile hFile, sBuff, MAX_BUFFER_LENGTH, Ret
        sData = sBuff
        Do While Ret <> 0
            If bForm Then
                frm.Label1 = "Downloading ... " & Format(Len(sData) / 1024, 0) & " KB"
                frm.Label3 = " " & FormatNumber(StopTimer, 2)
                frm.Label1.Refresh
                frm.Label3.Refresh
            End If
            InternetReadFile hFile, sBuff, MAX_BUFFER_LENGTH, Ret
            sData = sData + Mid(sBuff, 1, Ret)
        Loop
        dData = Len(sData): iFile = FreeFile
        Open sFileName For Binary Access Write Lock Write As #iFile
        Put #iFile, , sData: Close #iFile
    End If
    InternetCloseHandle hFile
    InternetCloseHandle hOpen
    sData = ""
End Sub

Private Sub StartTimer()
    m_StopWatch = Timer
End Sub

Private Function StopTimer()
    Dim EndTime
    EndTime = Timer
    StopTimer = EndTime - m_StopWatch
End Function

Private Function Numeric2Bytes(ByVal b As Double) As String
    Dim bSize(8) As String
    Dim i As Integer
    bSize(0) = "Bytes"
    bSize(1) = "KB" 'Kilobytes
    bSize(2) = "MB" 'Megabytes
    bSize(3) = "GB" 'Gigabytes
    bSize(4) = "TB" 'Terabytes
    bSize(5) = "PB" 'Petabytes
    bSize(6) = "EB" 'Exabytes
    bSize(7) = "ZB" 'Zettabytes
    bSize(8) = "YB" 'Yottabytes
    b = CDbl(b)
    For i = UBound(bSize) To 0 Step -1
        If b >= (1024 ^ i) Then
            Numeric2Bytes = ThreeNonZeroDigits(b / (1024 ^ _
                i)) & " " & bSize(i)
            Exit For
        End If
    Next
End Function

Private Function ThreeNonZeroDigits(ByVal value As Double) _
    As String
    If value >= 100 Then
        ThreeNonZeroDigits = Format$(CInt(value))
    ElseIf value >= 10 Then
        ThreeNonZeroDigits = Format$(value, "0.0")
    Else
        ThreeNonZeroDigits = Format$(value, "0.00")
    End If
End Function

Public Sub SetWindowToTop(ByVal plnghWnd As Long)
    SetWindowPos plnghWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Sub
Public Sub SetWindowNotToTop(ByVal plnghWnd As Long)
    SetWindowPos plnghWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub

Private Function usrDelayProgram(nSeconds)
    Dim nStoptime As Single
    nStoptime = Timer + nSeconds
    Do While Timer <= nStoptime
        DoEvents
        Me.ZOrder
    Loop
End Function

Private Sub Form_Load()
    Dim FileSize As Double
    '// SHOW FORM AND SET TO TOP
    Me.Show: SetWindowToTop Me.hWnd
    '// START DOWNLOAD
    DownloadAPIProgress "http://www.somewebsite.com/files/setup.exe", FileSize, , Me
    '// DOWNLOAD SUCCEEDED
    If FileSize Then
        Me.Label1 = "Download Complete: " & Numeric2Bytes(FileSize)
        APIBeep 1000, 100
        APIBeep 500, 150
        APIBeep 1800, 100
        APIBeep 1500, 200
    Else
    '// DOWNLOAD FAILED
        Beep
        Me.Label1 = "Download Failed"
    End If
    '// DELAY ON EXIT
    usrDelayProgram 2
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    '// REMOVE FROM TOP
    SetWindowNotToTop Me.hWnd
End Sub