【问】如何不用外部控件，实现能有进度反馈的后台网上下载文件？

Question

API是最方便的，但URLDownloadToFile却无进度提示。
还有一种方法，使用DoFileDownload，但会调出IE的下载界面。现在只想用自己的界面显示下载的进度（这需要同步下载反馈），
而且不想使用外部控件，如WinSock，WebBrowers等。最好就是能有回调的API请问，如何做到？

Answer 1

哪来的“已下载大小”“文件总大小”？
哪个API得出的？？？

Answer 2

To supergreenbean(超级绿豆 - 世界上只有一种人不能得罪 —— 女人) ：
实现了URLDownloadToFile接口的方式，为啥在下载的时候，IE是锁住的呢（本程序却没有锁住）？

Answer 3

转贴 以下为CLSOption Explicit
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 InternetCloseHandle Lib "wininet" (ByRef hInet As Long) As Long
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, sBuffer As Byte, 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 Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByVal sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const scUserAgent = "Tgwang"
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const INTERNET_FLAG_RELOAD = &H80000000Private mvarUrl As String
Private mvarSaveFile As String
Private mvarConnect As Boolean
Private hOpen As Long, hFile As Long
Private Buffer As String, BufLen As Long
Private RetQueryInfo As Boolean
Public Event GetData(Progress As Long)
Public Event ErrMassage(Description As String)
Public Event DownLoadOver()Public Sub Execute()    mvarConnect = True    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)    If mvarConnect = False Then
        Cancel
        Exit Sub
    End If    If hOpen = 0 Then
        Cancel
        RaiseEvent ErrMassage("无法创建连接")
        mvarConnect = False
    Else        hFile = InternetOpenUrl(hOpen, mvarUrl, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)        If mvarConnect = False Then
            Cancel
            Exit Sub
        End If        If hFile = 0 Then
            Cancel
            RaiseEvent ErrMassage("无法连接服务器")
            mvarConnect = False
        Else
            Buffer = Space$(1024)
            BufLen = 1024
            RetQueryInfo = HttpQueryInfo(hFile, 21, Buffer, BufLen, 0)            If RetQueryInfo Then
                Buffer = Mid$(Buffer, 1, BufLen)
            Else
                Buffer = ""
            End If        End If    End IfEnd Sub
Public Function StartDownLoad() As Boolean    Dim sBuffer(1 To 1024) As Byte, Ret As Long
    Dim intfile As Long, LBR As Long
    Dim i As Long    If mvarConnect = False Then
        Cancel
        StartDownLoad = False
        Exit Function
    End If    On Error GoTo OutErr
    Err.Clear
    If Len(Dir$(mvarSaveFile)) > 0 Then
        If MsgBox("目标文件以存在是否覆盖!", vbInformation + vbYesNo, "提示") = vbNo Then
            Cancel
            StartDownLoad = False
            Exit Function
        End If
    End If
    intfile = FreeFile()    Open mvarSaveFile For Binary Access Write As #intfile
    Do
        InternetReadFile hFile, sBuffer(1), 1024, Ret
        DoEvents
        If Ret = 1024 Then
            If mvarConnect = False Then
                StartDownLoad = False
                GoTo Quit
            End If            Put #1, , sBuffer
        Else
            For i = 1 To Ret
                Put #1, , sBuffer(i)
                DoEvents
            Next i
        End If
        LBR = LBR + Ret
        RaiseEvent GetData(LBR)
        DoEvents
    Loop Until Ret < 1024
    RaiseEvent DownLoadOver
Quit:
    Close #intfile    Cancel    Exit FunctionOutErr:
    Err.Clear
    Cancel
    Close #intfile
    RaiseEvent ErrMassage("文件" & mvarSaveFile & "正在使用,无法进行操作")
    On Error GoTo 0End FunctionPublic Sub Cancel()    mvarConnect = False
    InternetCloseHandle hOpen
    InternetCloseHandle hFileEnd SubPublic Property Let SaveFile(ByVal FileName As String)    mvarSaveFile = FileNameEnd PropertyPublic Property Let URL(ByVal URL As String)
    mvarUrl = URLEnd Property
Public Function GetHeader(Optional hdrName As String) As String    Dim tmp As Long
    Dim tmp2 As String    If mvarConnect = False Then
        GetHeader = "0"
        Cancel
        Exit Function
    End If
    If Buffer <> "" Then
        Select Case UCase$(hdrName)
            Case "CONTENT-LENGTH"
                tmp = InStr(Buffer, "Content-Length")
                tmp2 = Mid$(Buffer, tmp + 16, Len(Buffer))
                tmp = InStr(tmp2, Chr$(0))
                GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
            Case "CONTENT-TYPE"
                tmp = InStr(Buffer, "Content-Type")
                tmp2 = Mid$(Buffer, tmp + 14, Len(Buffer))
                tmp = InStr(tmp2, Chr$(0))
                GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
            Case "DATE"
                tmp = InStr(Buffer, "Date")
                tmp2 = Mid$(Buffer, tmp + 6, Len(Buffer))
                tmp = InStr(tmp2, Chr$(0))
                GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
            Case "LAST-MODIFIED"
                tmp = InStr(Buffer, "Last-Modified")
                tmp2 = Mid$(Buffer, tmp + 15, Len(Buffer))
                tmp = InStr(tmp2, Chr$(0))
                GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
            Case "SERVER"
                tmp = InStr(Buffer, "Server")
                tmp2 = Mid$(Buffer, tmp + 8, Len(Buffer))
                tmp = InStr(tmp2, Chr$(0))
                GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
            Case vbNullString
                GetHeader = Buffer
            Case Else
                GetHeader = "0"
        End Select
    Else
        GetHeader = "0"
    End IfEnd Function

Answer 4

以下为窗体两个按钮、、两个TextBox、一个标签(command1,command2,text1,text2,label1)Option Explicit
Dim WithEvents tg As DownLoad
Dim tmp As LongPrivate Sub Command1_Click()
    tg.URL = Text1.Text                                            '设置下载地址
    tg.SaveFile = Text2.Text                                       '下载后的文件存放位置
    tg.Execute                                             '连接网络
    tmp = CLng(tg.GetHeader("Content-Length"))             '获取下载文件大小
    tg.StartDownLoad                                       '开始下载
End SubPrivate Sub Command2_Click()    tg.CancelEnd SubPrivate Sub Form_Load()    Set tg = New DownLoad
    T1 = "http://syse.27h.com/down/cdromlock/v1.0 for win9x/setup.exe"
    T2 = App.Path & "\setup.exe"
    Command1.Caption = "下载"
    Command2.Caption = "停止"
End SubPrivate Sub tg_DownLoadOver()
    MsgBox "下载成功！", vbInformation, "提示"
End SubPrivate Sub tg_ErrMassage(Description As String)
    MsgBox Description, vbCritical, "错误"End SubPrivate Sub tg_GetData(Progress As Long)
L = Format$(Progress, "###,###") & "/" & Format$(tmp, "###,###")
Label1.Caption = CInt((Progress / tmp) * 100) & "%"       '显示下载进度End Sub