dlmain.ctl

HTTP文件下载控件源代码 提供了使用HTTP下载文件时的控制方法及处理方法

    lBR = lBR + UBound(bData, 1) + 1
    m_BYTES = lBR
    r_RateTransfer = lBR / (Timer - t_OldTime)
    t_Time = (m_FileSize - lBR) / r_RateTransfer
    RaiseEvent Rate(FormatFileSize(r_RateTransfer))
    RaiseEvent TimeLeft(FormatTime(t_Time))
    RaiseEvent RecievedBytes(lBR)
    RaiseEvent Percent(Round((lBR / m_FileSize) * 100, 0))
    RaiseEvent StatusChange("Recieving File, Inputting DATA to File.")
    If c_Pause = True Then
    While c_Pause = True
    DoEvents
    RaiseEvent StatusChange("Paused.")
    Wend
    End If
Loop While UBound(bData, 1) > 0
Close #intfile
m_InDL = False
RaiseEvent DLComplete
RaiseEvent StatusChange("Download Successful!")
I1.Cancel
Exit Sub
DLE:
RaiseEvent DLError("Error Downloading File from : " & m_URL)
RaiseEvent StatusChange("Download Aborted Due To Error In Download!")
RaiseEvent DLECode(1)
I1.Cancel
Exit Sub
End Sub

Sub GetFileInformation()
On Error GoTo Ge
Dim sHeader As String
Dim blnreturn As Boolean

If c_Cancel = True Then
c_Cancel = False
End If

If m_OnlineCheck = True Then
blnreturn = IsOnline
    If blnreturn = False Then
        MsgBox "You are not currently connected to the internet!" & vbCrLf & "The download will be aborted!"
        m_Connected = False
        RaiseEvent DLECode(5)
        RaiseEvent DLError("No Connection Found!")
        RaiseEvent StatusChange("Download aborted, no connection present!")
        Exit Sub
    Else
        m_Connected = True
    End If
End If

I1.Url = m_URL
I1.Execute , "GET"
RaiseEvent StatusChange("Initiating Connection.")
While I1.StillExecuting
    DoEvents
Wend

RaiseEvent StatusChange("Connection Accepted, Retrieving File Information.")

If c_Cancel = True Then GoTo Cc

sHeader = I1.GetHeader()
Select Case Mid$(sHeader, 10, 3)


Case 401
RaiseEvent StatusChange("Unauthorized Access, Download Terminated!")
RaiseEvent DLECode(401)
RaiseEvent DLError("Unauthorized Access!")
a_Resume = False
I1.Cancel
m_FileExists = True
m_FileSize = 0
Exit Sub

Case 403
RaiseEvent StatusChange("Access Denied, Download Terminated!")
RaiseEvent DLECode(403)
RaiseEvent DLError("Access Denied!")
a_Resume = False
m_FileExists = True
m_FileSize = 0
I1.Cancel
Exit Sub

Case 404
    RaiseEvent DLError("File Not Found!")
    RaiseEvent StatusChange("File Not Found!")
    RaiseEvent DLECode(2)
    m_FileExists = False
    m_FileSize = 0
    I1.Cancel
    Exit Sub

End Select

If c_Cancel = True Then GoTo Cc

If Mid$(aheader, 6, 3) = "1.1" Then a_Resume = True

m_FileExists = True
t_OldTime = Timer - 1
m_FileSize = CLng(I1.GetHeader("Content-Length"))
RaiseEvent StatusChange("Retrieving File Information Complete!")
Exit Sub

Ge:
RaiseEvent DLError("Error Reading File Headers.")
RaiseEvent StatusChange("Error Reading File Headers!")
RaiseEvent DLECode(3)
Exit Sub

Cc:
c_Cancel = False
RaiseEvent DLECode(4)
RaiseEvent StatusChange("cancelled.")
Exit Sub
End Sub

Sub Cancel()
c_Cancel = True
RaiseEvent StatusChange("Cancelling..")
End Sub

Private Function FormatTime(ByVal sglTime As Single) As String
                           
Select Case sglTime
    Case 0 To 59
        FormatTime = Format(sglTime, "0") & " sec"
    Case 60 To 3599
        FormatTime = Format(Int(sglTime / 60), "#0") & _
                     " min " & _
                     Format(sglTime Mod 60, "0") & " sec"
    Case Else
        FormatTime = Format(Int(sglTime / 3600), "#0") & _
                     " hr " & _
                     Format(sglTime / 60 Mod 60, "0") & " min"
End Select

End Function

Private Function FormatFileSize(ByVal dFileSize As Double) As String

Select Case dFileSize
    Case 0 To 1023
        FormatFileSize = Round(dFileSize, 0) & " Bytes/S"
    Case 1024 To 1048575
        FormatFileSize = Round(dFileSize / 1024, 2) & " KB/S"
End Select

End Function

Private Function KeepSave(lpURL As String, lpSL As String) As String
Dim temphold(1 To 2) As String
Dim lplace(1 To 2) As Long
lplace(1) = InStr(Len(lpURL) - 5, lpURL, ".", vbTextCompare)
temphold(1) = Right$(lpURL, Len(lpURL) - lplace(1))
lplace(2) = InStr(Len(lpSL) - 5, lpSL, ".", vbTextCompare)
temphold(2) = Left$(lpSL, lplace(2))
KeepSave = temphold(2) & temphold(1)
End Function

Private Function IsOnline() As Boolean
Dim lflag As Long
Dim blnreturn As Boolean
blnreturn = InternetGetConnectedState(lflag, 0)

If lflag And INTERNET_CONNECTION_MODEM Then
RaiseEvent ConnectionState("Connected Via Modem.")
End If
If lflag And INTERNET_CONNECTION_LAN Then
RaiseEvent ConnectionState("Connected Via LAN.")
End If
If lflag And INTERNET_CONNECTION_PROXY Then
RaiseEvent ConnectionState("Connected Through A Proxy.")
End If

IsOnline = blnreturn
End Function

Sub DLResume()
On Error GoTo DLE
Dim lpHeader As String
Dim lpdestination As String
Dim lpdestination2 As String
Dim strreturn As String
Dim CHUNK As Long
Dim bData() As Byte
Dim intfile As Integer
Dim lBR As Long
Dim SFV As Long
If c_Cancel = True Then
Exit Sub
End If

If m_OnlineCheck = True Then
    If m_Connected = False Then
        RaiseEvent DLECode(5)
        RaiseEvent DLError("No Connection Found!")
        RaiseEvent StatusChange("Download aborted, no connection present!")
        I1.Cancel
        Exit Sub
    End If
End If

I1.Url = m_URL
CHUNK = m_CHUNK
lpdestination = m_SaveLocation

If Dir$(m_SaveLocation) < " " Then
RaiseEvent DLError("Resume File Not Found!")
RaiseEvent DLECode(6)
RaiseEvent StatusChange("Resume File Not Found, Aborting Download!")
Exit Sub
End If

If a_Resume = False Then
RaiseEvent DLError("Resume Not Supported!")
RaiseEvent DLECode(7)
RaiseEvent StatusChange("Resume NotSupported, Aborting Download!")
Exit Sub
End If

I1.Execute , "GET", , "Range: bytes=" & CStr(SFV) & "-" & vbCrLf

While I1.StillExecuting
DoEvents
Wend

SFV = FileLen(m_SaveLocation)
intfile = FreeFile()

Open m_SaveLocation For Binary Access Write As #intfile
Seek #intfile, SFV + 1
RaiseEvent StatusChange("Opening " & lpdestination & " For DATA Input.")
m_InDL = True
Do
    If c_Cancel = True Then
    c_Cancel = False
    Close #intfile
    RaiseEvent DLECode(4)
    RaiseEvent StatusChange("Cancelled.")
    Exit Sub
    End If
    bData = I1.GetChunk(CHUNK, icByteArray)
    Put #intfile, , bData
    lBR = lBR + UBound(bData, 1) + 1
    m_BYTES = lBR
    r_RateTransfer = lBR / (Timer - t_OldTime)
    t_Time = (m_FileSize - lBR) / r_RateTransfer
    RaiseEvent Rate(FormatFileSize(r_RateTransfer))
    RaiseEvent TimeLeft(FormatTime(t_Time))
    RaiseEvent RecievedBytes(lBR + SFV)
    RaiseEvent Percent(Round(((lBR + SFV) / m_FileSize) * 100, 0))
    RaiseEvent StatusChange("Recieving File, Inputting DATA to File.")
    If c_Pause = True Then
    While c_Pause = True
    DoEvents
    RaiseEvent StatusChange("Paused.")
    Wend
    End If
Loop While UBound(bData, 1) > 0
Close #intfile
m_InDL = False
RaiseEvent DLComplete
RaiseEvent StatusChange("Download Successful!")
I1.Cancel
Exit Sub
DLE:
RaiseEvent DLError("Error Downloading File from : " & m_URL)
RaiseEvent StatusChange("Download Aborted Due To Error In Download!")
RaiseEvent DLECode(1)
I1.Cancel
Exit Sub
End Sub

Sub Pause(blnPause As Boolean)
c_Pause = blnPause
If c_Pause = False Then
RaiseEvent StatusChange("Unpausing")
End If
End Sub