frmdatabasebackup.frm

三层架构的数据C/S, 主要是学生成绩的管理体制

VERSION 5.00
Begin VB.Form frmDatabaseBackup 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "数据库备份"
   ClientHeight    =   2880
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   6435
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   2880
   ScaleWidth      =   6435
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdBackup 
      Caption         =   "开始备份"
      Height          =   350
      Left            =   3240
      TabIndex        =   8
      Top             =   2280
      Width           =   1000
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "关闭"
      Height          =   350
      Left            =   4560
      TabIndex        =   7
      Top             =   2280
      Width           =   1000
   End
   Begin VB.Frame Frame1 
      Height          =   1935
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   6255
      Begin VB.TextBox txtDestination 
         Height          =   285
         Left            =   2040
         TabIndex        =   2
         Top             =   960
         Width           =   3495
      End
      Begin VB.CommandButton cmdDestination 
         Caption         =   "..."
         Height          =   285
         Left            =   5640
         TabIndex        =   1
         Top             =   960
         Width           =   375
      End
      Begin VB.Label lblDbaSize 
         Caption         =   "当前数据库容量为："
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   6
         Top             =   360
         Width           =   1815
      End
      Begin VB.Label Label1 
         Caption         =   "备份的目标位置："
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   960
         Width           =   1575
      End
      Begin VB.Label lblStatus 
         Alignment       =   2  'Center
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   720
         TabIndex        =   4
         Top             =   1440
         Width           =   4695
      End
      Begin VB.Label lblSize 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   360
         Left            =   1950
         TabIndex        =   3
         Top             =   360
         Width           =   1875
      End
   End
End
Attribute VB_Name = "frmDatabaseBackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim dbasize As Long
Dim PathName As String

Private Sub cmdBackup_Click()
    If txtDestination <> "" Then
    DoBackup PathName, txtDestination
    ElseIf txtDestination = "" Then
      MsgBox "You must specify a distination for the backup", vbCritical
    End If
End Sub

Private Sub cmdClose_Click()
    Me.Hide
    Unload Me
End Sub

Private Sub cmdDestination_Click()
    Dim strTemp As String
    
    strTemp = fBrowseForFolder(Me.hwnd, "Select backup path")
    If strTemp <> "" Then
        txtDestination = strTemp
    End If
End Sub

Private Sub Form_Activate()
    lblSize = Format((dbasize / 1024) / 1024, "standard") & "MB."
End Sub

Private Sub Form_Load()
    'SetRegion
    PathName = App.Path & "\Student.MDB"
    dbasize = FileLen(PathName)
End Sub

Public Sub DoBackup(strSourcePath As String, strDestinationPath As String)
    On Error Resume Next
    Dim lFileOp  As Long
    Dim lresult  As Long
    Dim lFlags   As Long
    Dim SHFileOp As SHFILEOPSTRUCT
    Dim strSourceDir As String
    Dim strDestinationDir As String
    
    Screen.MousePointer = vbHourglass
    BackupFolderName = strDestinationPath
    MkDir BackupFolderName & "\Backup - " & Format(Date, "yyyy.mm.dd")
    lFileOp = FO_COPY
    lFlags = lFlags And Not FOF_SILENT
    lFlags = lFlags Or FOF_NOCONFIRMATION
    lFlags = lFlags Or FOF_NOCONFIRMMKDIR
    lFlags = lFlags Or FOF_FILESONLY
    With SHFileOp
        .wFunc = lFileOp
        .pFrom = strSourcePath & vbNullChar
        .pTo = strDestinationPath & "\Backup - " & Format(Date, "yyyy.mm.dd") & vbNullChar
        .fFlags = lFlags
    End With
    lresult = SHFileOperation(SHFileOp)
    
    Screen.MousePointer = vbDefault
    frmDatabaseBackup.lblStatus = "备份完成！"
End Sub