frmdltest1.frm

数据库连接

VERSION 5.00
Object = "{20DD27F9-A698-4CD1-B995-1ED20DBDB6B9}#1.0#0"; "bkDLControl.ocx"
Begin VB.Form frmDLTest 
   Caption         =   "在线升级程序演示"
   ClientHeight    =   5820
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7725
   Icon            =   "frmDLTest1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5820
   ScaleWidth      =   7725
   StartUpPosition =   3  '窗口缺省
   Begin 工程1.bkDLControl DL 
      Height          =   375
      Left            =   720
      Top             =   1080
      Width           =   6255
      _ExtentX        =   11033
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.ComboBox cboURL 
      Height          =   300
      ItemData        =   "frmDLTest1.frx":014A
      Left            =   1560
      List            =   "frmDLTest1.frx":0169
      TabIndex        =   0
      Top             =   360
      Width           =   5745
   End
   Begin VB.ListBox lstOut 
      Appearance      =   0  'Flat
      Columns         =   1
      Height          =   3090
      ItemData        =   "frmDLTest1.frx":0407
      Left            =   240
      List            =   "frmDLTest1.frx":0409
      TabIndex        =   3
      Top             =   2280
      Width           =   7095
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取 消"
      Enabled         =   0   'False
      Height          =   375
      Left            =   3840
      TabIndex        =   2
      Top             =   1680
      Width           =   1575
   End
   Begin VB.CommandButton cmdBegin 
      Caption         =   "开 始"
      Height          =   375
      Left            =   1560
      TabIndex        =   1
      Top             =   1680
      Width           =   1575
   End
   Begin VB.Label lblProg 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Height          =   180
      Left            =   5640
      TabIndex        =   5
      Top             =   1440
      Width           =   90
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "下载地址："
      Height          =   180
      Left            =   360
      TabIndex        =   4
      Top             =   480
      Width           =   900
   End
End
Attribute VB_Name = "frmDLTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Option Explicit



Private Sub cmdBegin_Click()
    With DL
        .FileURL = cboURL.Text
        .SaveFilePath = "f:\"
        LogItem "请求下载" & cboURL.Text
        .BeginDownload
    End With
    cmdCancel.Enabled = True
End Sub

Private Sub cmdCancel_Click()
    DL.CancelDownload
End Sub

Private Sub DL_DLBeginDownload()
    LogItem "开始下载从" & DL.FileURL
End Sub

Private Sub DL_DLCanceled()
    LogItem "取消下载"
End Sub

Private Sub DL_DLComplete(Bytes As Long)
    'download terminated - bytes is > 0 if successful (file size)
    cmdCancel.Enabled = False
    If Bytes > 0& Then
        LogItem "完成" & SizeString(Bytes) & "下载并保存到" & DL.SaveFileName
    Else
        LogItem "下载失败"
    End If
End Sub

'Returns IP address of successful connection
Private Sub DL_DLConnected(ConnAddr As String)
    LogItem "连接到 " & ConnAddr
End Sub
'Error!  See UC code for different possible errors
'This event is always followed by DLComplete returning 0 bytes
Private Sub DL_DLError(E As bkDLError, Error As String)
Dim strErrType As String
    Select Case E
        Case bkDLEUnavailable
            strErrType = "不可下载文件"
        Case bkDLERedirect
            strErrType = "重定向"
        Case bkDLEZeroLength
            strErrType = "没有字节返回"
        Case bkDLESaveError
            strErrType = "文件保存错误"
        Case bkDLEUnknown
            strErrType = "不明错误"
    End Select
    LogItem "错误 - " & strErrType & ": " & Error
End Sub

Private Sub DL_DLFileSize(Bytes As Long)
    'Size in bytes.  returned when connection to file is complete
    'and download actually begins
    LogItem "文件大小为" & SizeString(Bytes) & " (" & CStr(Bytes) & " bytes)"
End Sub

Private Sub DL_DLMIMEType(MIMEType As String)
    'handy info!
    LogItem "MIME类型是 " & MIMEType
End Sub

Private Sub DL_DLProgress(Percent As Single, BytesRead As Long, TotalBytes As Long)

  lblProg.Caption = Format(Percent, "0%") & " of " & SizeString(TotalBytes)
End Sub

Private Sub DL_DLRedirect(ConnAddr As String)
    'Returns path to file if redirected
    'This event wont fire at all if FailOnRedirect is True! (DLError instead)
    LogItem Index, "重定向到" & ConnAddr
End Sub

Private Sub Form_Load()
    'initialize sample inputs

    cboURL.ListIndex = 0

End Sub

Private Sub LogItem(strItem As String)
    With lstOut
        .AddItem "> " & strItem
        If .NewIndex > .TopIndex + 17 Then
            .TopIndex = .NewIndex - 16
        End If
    End With
End Sub

Private Function SizeString(lBytes As Long) As String
    If lBytes < &H400& Then
        SizeString = CStr(lBytes) & "b"
    ElseIf lBytes < &H100000 Then
        SizeString = CStr(lBytes \ 1024) & "k"
    ElseIf lBytes < &H20000000 Then
        SizeString = Replace$(Format$((lBytes \ 1024) / 1024, "0.0"), ".0", vbNullString) & "M"
    Else
        SizeString = Replace$(Format$((lBytes \ (1024 ^ 2)) / 1024, "#,##0.0"), ".0", vbNullString) & "G"
    End If
End Function