下载.frm

适合于中小型企业管理

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Act_Download 
   BackColor       =   &H00E0E0E0&
   BorderStyle     =   0  'None
   ClientHeight    =   1815
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5340
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1815
   ScaleWidth      =   5340
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   2310
      Top             =   780
   End
   Begin VB.Frame Fra_Main 
      BackColor       =   &H00E0E0E0&
      Height          =   375
      Left            =   180
      TabIndex        =   2
      Top             =   360
      Width           =   5000
      Begin MSComctlLib.ProgressBar PrgBarMain 
         DragMode        =   1  'Automatic
         Height          =   165
         Left            =   60
         TabIndex        =   3
         Top             =   150
         Width           =   4905
         _ExtentX        =   8652
         _ExtentY        =   291
         _Version        =   393216
         Appearance      =   0
      End
   End
   Begin VB.Frame Fra_Sub 
      BackColor       =   &H00E0E0E0&
      Height          =   345
      Left            =   180
      TabIndex        =   0
      Top             =   1170
      Width           =   5000
      Begin MSComctlLib.ProgressBar PrgBarSub 
         Height          =   165
         Left            =   60
         TabIndex        =   1
         Top             =   120
         Width           =   4905
         _ExtentX        =   8652
         _ExtentY        =   291
         _Version        =   393216
         Appearance      =   0
         Max             =   1200
      End
   End
   Begin VB.Label Lbl_Main 
      BackColor       =   &H00E0E0E0&
      Caption         =   "文件下载进度:"
      ForeColor       =   &H00FF0000&
      Height          =   195
      Left            =   180
      TabIndex        =   5
      Top             =   180
      Width           =   4995
   End
   Begin VB.Label Lbl_Sub 
      BackColor       =   &H00E0E0E0&
      Caption         =   "正在下载:"
      ForeColor       =   &H00FF0000&
      Height          =   225
      Left            =   210
      TabIndex        =   4
      Top             =   990
      Width           =   4965
   End
End
Attribute VB_Name = "Act_Download"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public glScale As Long

Private Sub Timer1_Timer()
    Timer1.Enabled = False
    Call fun_bDownloaded
    Unload Me
End Sub

Private Function fun_bDownloaded() As Boolean
Dim sConnectStr As String
Dim rs As New Recordset
Dim sEstr As String, sSql As String, sTmp As String
Dim sFName As String
Dim iCount As Integer, i As Integer
    On Error GoTo errD
    
    '连接指定数据库
    
    With MainFrm
        For i = 0 To .Label1.Count - 2
            If sArrVer(i) = "1" Then
                sTmp = sTmp & " OR ModelName='" & .Label1(i).Tag & "'"
            End If
        Next i
    End With
    
    sSql = "SELECT isnull(SUM(FileSize),0),COUNT(1) FROM EboSys..Sys_Update WHERE 1=1" & sTmp
    Set rs = Cw_DataEnvi.DataConnect.Execute(sSql)
    If Not rs.EOF Then
        glScale = rs.Fields(0) / 5 / 32000
        iCount = rs.Fields(1)
    Else
        glScale = 1
    End If
    MainFrm.lblMsg.Caption = "正在下载..."
    MainFrm.lblMsg.Refresh
    
    Me.PrgBarMain.Max = 32000
    rs.Close
    sSql = "SELECT * FROM EboSys..Sys_Update WHERE 1=1 " & sTmp
    Set rs = Cw_DataEnvi.DataConnect.Execute(sSql)
    i = 1
    While Not rs.EOF            '全部文件下载模块，包括非.EXE文件
        sFName = rs.Fields("ModelName")
        Call fun_bFileOperate(sFName, sEstr)                 '修改现有目标文件名，避免冲突
        Me.PrgBarSub.Max = rs.Fields("FileSize") / 5 / glScale
        Lbl_Main.Caption = "文件下载进度:" & Space(36) & i & "/" & iCount: Lbl_Main.Refresh
        Lbl_Sub.Caption = "正在下载:" & Space(32) & rs.Fields("ModelName"): Lbl_Sub.Refresh
        
        MainFrm.lblMsg.Caption = "正在下载..." & rs.Fields("ModelName")
        MainFrm.lblMsg.Refresh
        
        If GetBlobFromDB(rs, "FileBody") Then '从数据库里下载指定文件
            Me.PrgBarSub.Value = Me.PrgBarSub.Max
        End If

        i = i + 1
        rs.MoveNext
        PrgBarSub.Value = 0
        '主进度条调整，子进度条清零
    Wend
    PrgBarMain.Value = 32000
    fun_bDownloaded = True
errD:
End Function

Private Function fun_bFileOperate(sFileName As String, errStr As String) As Boolean
'
Dim sFullFileName As String
Dim sBckFFileName As String
On Error GoTo errD
    sFullFileName = App.Path & "\" & sFileName
    sBckFFileName = App.Path & "\bak\" & Mid(sFileName, 1, Len(sFileName) - 3) & "bak"

    If Dir(sFullFileName) <> "" Then
         Name sFullFileName As sBckFFileName
    End If
    
  fun_bFileOperate = True
Exit Function

errD:
    errStr = Err.Description
End Function