VB6使用API下载文件

小弟用VB6.0编制了一个小程序，使用win32的关于internet 的API来下载文件。程序用户界面如下 本程序包括两个文件 frmDownLoad.frm （主窗体)和clsCount.cls(计算下载速度的类模块) 大家建立一个简单的VB应用程序项目，将两个文件加入项目即可
我觉得clsCount.cls有问题，望有心人查查

'##############################################################################
'**
'**   文件 frmDownLoad.frm 的内容
'**
'##############################################################################
VERSION 5.00
Begin VB.Form frmDownLoad 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   2880
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6375
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "文件下载"
   MaxButton       =   0   'False
   ScaleHeight     =   2880
   ScaleWidth      =   6375
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdStop 
      Caption         =   "停止"
      Enabled         =   0   'False
      Height          =   480
      Left            =   1860
      TabIndex        =   6
      Top             =   2160
      Width           =   1365
   End
   Begin VB.CommandButton cmdStart 
      Caption         =   "开始"
      Height          =   480
      Left            =   165
      TabIndex        =   5
      Top             =   2160
      Width           =   1365
   End
   Begin VB.TextBox txtFile 
      Height          =   330
      Left            =   750
      TabIndex        =   3
      Top             =   705
      Width           =   5445
   End
   Begin VB.TextBox txtURL 
      Height          =   330
      Left            =   750
      TabIndex        =   1
      Top             =   285
      Width           =   5445
   End
   Begin VB.Label lblCount 
      BackStyle       =   0  'Transparent
      Caption         =   "下载"
      Height          =   180
      Left            =   180
      TabIndex        =   4
      Top             =   1245
      Width           =   5130
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "文件:"
      Height          =   180
      Left            =   195
      TabIndex        =   2
      Top             =   780
      Width           =   450
   End
   Begin VB.Label lblURL 
      AutoSize        =   -1  'True
      Caption         =   "URL:"
      Height          =   180
      Left            =   195
      TabIndex        =   0
      Top             =   360
      Width           =   360
   End
End
Attribute VB_Name = "frmDownLoad"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function StrFormatByteSize Lib "shlwapi" Alias _
"StrFormatByteSizeA" (ByVal dw As Long, ByVal pszBuf As String, ByRef _
cchBuf As Long) As String

Private Declare Function InternetOpen Lib "wininet.dll" _
  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 InternetOpenUrl Lib "wininet.dll" _
   Alias "InternetOpenUrlA" (ByVal hOpen As Long, _
   ByVal surl As String, ByVal sHeaders As String, _
   ByVal lLength As Long, ByVal lFlags As Long, _
   ByVal lContext As Long) As Long

Private Declare Function HttpOpenRequest Lib "wininet.dll" _
   Alias "HttpOpenRequestA" _
   (ByVal hInternetSession As Long, _
    ByVal lpszVerb As String, _
    ByVal lpszObjectName As String, _
    ByVal lpszVersion As String, _
    ByVal lpszReferer As String, _
    ByVal lpszAcceptTypes As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long
      Private Declare Function InternetConnect Lib "wininet.dll" _
         Alias "InternetConnectA" _
         (ByVal hInternetSession As Long, _
          ByVal lpszServerName As String, _
          ByVal nProxyPort As Integer, _
          ByVal lpszUsername As String, _
          ByVal lpszPassword As String, _
          ByVal dwService As Long, _
          ByVal dwFlags As Long, _
          ByVal dwContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" _
   Alias "HttpSendRequestA" _
   (ByVal hHttpRequest As Long, _
    ByVal sHeaders As String, _
    ByVal lHeadersLength As Long, _
    ByVal sOptional As String, _
    ByVal lOptionalLength As Long) As Boolean

Private Declare Function InternetReadFile Lib "wininet.dll" _
   (ByVal hFile As Long, ByRef sBuffer As Byte, _
   ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) _
   As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
        (ByVal hInet As Long) As Integer
        
Private Declare Function GetLastError Lib "kernel32" () As Long
        
' Adds one or more HTTP request headers to the HTTP request handle.
'Public Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" _
'(ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, _
'ByVal lModifiers As Long) As Integer
Private bolStop As Boolean
   ' 然后，我们可以得到包含了一份详细说明的URL文本文件，它显示在下面的函数中：
Public Function DownloadFile(ByVal surl As String, ByVal strFile As String) As Long
    Dim s As String
    Dim hOpen As Long
    Dim hOpenUrl As Long
    Dim bDoLoop As Boolean
    Dim bRet As Boolean
    Dim intFH As Integer
    
    Dim sReadBuffer() As Byte
    Dim lNumberOfBytesRead As Long
    Dim lCount As Long
    Dim myCount As New clsCount
    Const INTERNET_OPEN_TYPE_PRECONFIG = 0
    Const INTERNET_OPEN_TYPE_DIRECT = 1
    Const INTERNET_OPEN_TYPE_PROXY = 3
    Const scUserAgent = "VB OpenUrl"
    Const INTERNET_FLAG_RELOAD = &H80000000
    
    lblCount.Caption = "正在连接服务器..."
    lblCount.Refresh
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    hOpenUrl = InternetOpenUrl(hOpen, surl, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
    lCount = 0
    
    If hOpen <> 0 And hOpenUrl <> 0 Then
        intFH = FreeFile
        If Dir(strFile) <> "" Then
            VBA.FileSystem.Kill strFile
        End If
        Open strFile For Binary As #intFH
        myCount.Clear
        Do While True
            ReDim sReadBuffer(2048)
            bRet = InternetReadFile(hOpenUrl, sReadBuffer(0), 2048, lNumberOfBytesRead)
            If lNumberOfBytesRead > 0 And bRet = True Then
                'if lnumberofbytesread<>2048 then
                ReDim Preserve sReadBuffer(0 To lNumberOfBytesRead - 1)
                Put #intFH, , sReadBuffer
'
'                buf.AddRange sReadBuffer, 0, lNumberOfBytesRead - 1
                lCount = lCount + lNumberOfBytesRead
                myCount.Count lNumberOfBytesRead
                lblCount.Caption = "已下载 " & VBStrFormatByteSize(lCount) & "  [ " & VBStrFormatByteSize(myCount.Speed) & " /秒 ]"
                lblCount.Refresh
            Else
                Exit Do
            End If
            bolStop = False
            DoEvents
            If bolStop = True Then
                Exit Do
            End If
        Loop
        Close #intFH
        lblCount.Caption = "共下载 " & lCount & " 字节"
    Else
        lblCount.Caption = "打开URL错误"
    End If
     
    If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
    If hOpen <> 0 Then InternetCloseHandle (hOpen)
    Set myCount = Nothing
    DownloadFile = lCount
 End Function
Private Sub cmdStart_Click()
    txtURL.Enabled = False
    txtFile.Enabled = False
    cmdStart.Enabled = False
    cmdStop.Enabled = True
    DownloadFile txtURL.Text, txtFile.Text
    cmdStop.Enabled = False
    cmdStart.Enabled = True
    txtFile.Enabled = True
    txtURL.Enabled = True
    
End Sub
Private Sub cmdStop_Click()
    bolStop = True
End Sub
Private Sub SetText(ByVal txt As TextBox)
    txt.Text = GetSetting(App.Title, Me.Name, txt.Name)
End Sub
Private Sub SaveText(ByVal txt As TextBox)
    SaveSetting App.Title, Me.Name, txt.Name, txt.Text
End Sub
Private Sub Form_Load()
    SetText Me.txtFile
    SetText Me.txtURL
End Sub
Private Sub Form_Unload(Cancel As Integer)
    SaveText Me.txtFile
    SaveText Me.txtURL
End Sub

Private Function VBStrFormatByteSize(ByVal lngSize As Long) As String
    Dim strSize As String * 128
    Dim strData As String
    Dim lPos        As Long
    StrFormatByteSize lngSize, strSize, 128
    lPos = InStr(1, strSize, Chr$(0))
    strData = Left$(strSize, lPos - 1)
    If lngSize > 1024 Then
        strData = lngSize & "字节(" & strData & ")"
    End If
    VBStrFormatByteSize = strData
End Function

'##############################################################################
'**
'**   文件 clsCount.cls 的内容
'**
'##############################################################################
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsCount"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'******************************************************************************
'**
'**     用于计算速度的类模块
'**
'** 该类模块设定一个计数器,由程序不断的累计数据,并根据所花时间计算数据
'**
'** 编制: 袁永福
'** 时间: 2002-4-2
'**
'******************************************************************************
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private lngCountStart   As Long
Private lngCountCurrent As Long
Private lngCountLast    As Long
Private lngSpeed        As Long
Private lngTickStart    As Long
Private lngTickCurrent  As Long
Private lngTickLast     As Long
'Public StopCount        As Boolean
'** 获得计数数据 **************************************************************
    '** 累计初始值
    Public Property Get CountStart() As Long
        CountStart = lngCountStart
    End Property
    '** 累计终止值
    Public Property Get CountEnd() As Long
        CountEnd = lngCountCurrent
    End Property
    '** 累计总的速度
    Public Property Get TotalSpeed() As Long
        If lngTickCurrent = lngTickStart Then
            TotalSpeed = 0
        Else
            TotalSpeed = (lngCountCurrent - lngCountStart) / ((lngTickCurrent - lngTickStart) / 1000)
        End If
    End Property
    '** 累计所花毫秒数
    Public Property Get TotalTickCount() As Long
        TotalTickCount = lngTickCurrent - lngTickStart
    End Property
'** 清除所有数据 **************************************************************
    Public Sub Clear()
        lngCountStart = 0
        lngCountCurrent = 0
        lngCountLast = 0
        
        lngSpeed = 0
        
        lngTickStart = GetTickCount()
        lngTickCurrent = lngTickStart
        lngTickLast = lngTickStart
        
        'StopCount = False
    End Sub
'** 设置累计基数
    Public Property Let CountStart(ByVal lStart As Long)
        lngCountStart = lStart
        lngCountCurrent = lStart
    End Property
'** 累加数据 **
    Public Sub Count(Optional ByVal lCount As Long = 1)
        lngCountCurrent = lngCountCurrent + lCount
        lngTickCurrent = GetTickCount()
    End Sub
    
'** 获得速度 **
    Public Property Get Speed() As Long
        'lngTickCurrent = GetTickCount()
        If lngTickLast = lngTickCurrent Then
            Speed = lngSpeed
        Else
            Speed = (lngCountCurrent - lngCountLast) / ((lngTickCurrent - lngTickLast) / 1000)
            lngSpeed = Speed
            lngTickLast = lngTickCurrent
            lngCountLast = lngCountCurrent
        End If
    End Property
    
'** 数据是否是最新更新的 **
    Public Property Get NewSpeed() As Boolean
        Dim bolNew As Boolean
        If lngTickCurrent > lngTickLast + 1000 Then
            bolNew = True
        Else
            bolNew = False
        End If
        NewSpeed = bolNew
    End Property
    
'** 本模块结束 ****************************************************************

本文地址：http://com.8s8s.com/it/it44190.htm