VB6使用API下载文件

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

   

'** 本模块结束 ****************************************************************