frmdatabaserestore.frm

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

VERSION 5.00
Begin VB.Form frmDatabaseRestore 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "数据库恢复"
   ClientHeight    =   3465
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   6750
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3465
   ScaleWidth      =   6750
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdClose 
      Caption         =   "取消"
      Height          =   375
      Left            =   4920
      TabIndex        =   10
      Top             =   2760
      Width           =   1095
   End
   Begin VB.CommandButton cmdRestore 
      Caption         =   "开始恢复"
      Enabled         =   0   'False
      Height          =   375
      Left            =   3600
      TabIndex        =   6
      Top             =   2760
      Width           =   1095
   End
   Begin VB.Frame Frame1 
      Height          =   2535
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   6495
      Begin VB.TextBox txtSource 
         Height          =   285
         Left            =   1920
         TabIndex        =   2
         Top             =   960
         Width           =   3615
      End
      Begin VB.CommandButton cmdSource 
         Caption         =   "..."
         Height          =   285
         Left            =   5640
         TabIndex        =   1
         Top             =   960
         Width           =   375
      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        =   9
         Top             =   360
         Width           =   1875
      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        =   8
         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           =   1695
      End
      Begin VB.Label lblSelectedDba 
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   240
         TabIndex        =   4
         Top             =   2040
         Width           =   5655
      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            =   360
         TabIndex        =   3
         Top             =   1560
         Width           =   5535
      End
   End
   Begin VB.Label Label3 
      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            =   1830
      TabIndex        =   7
      Top             =   0
      Width           =   1875
   End
End
Attribute VB_Name = "frmDatabaseRestore"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim dbasize As Long
Dim dbasize2 As Long
Dim PathName As String
Dim NoDba As Boolean
Private mclsMidTier As clsMidTier
Dim DB As Connection

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

Private Sub cmdRestore_Click()
    If MsgBox("恢复数据库从 " & txtSource & " 将替换已经存在的文件。你想继续吗？", vbYesNo) = vbYes Then
        DoRestore txtSource.Text, App.Path
'        If NoDba = True Then
         MsgBox "恢复数据库成功，单击[确定］然后退出程序！"
         frmDatabaseRestore.Hide
         Unload frmDatabaseRestore
'        End If
    Else
     lblStatus.Caption = "恢复数据库被中止！"
    End If
End Sub

Private Sub cmdSource_Click()
    On Error GoTo Erro
    Dim strTemp As String
    strTemp = fBrowseForFolder(Me.hwnd, "Restore From")
    If strTemp <> "" Then
        txtSource = strTemp
        dbasize2 = FileLen(txtSource & "\Student.MDB")
        lblSelectedDba = "请选择所备份的数据库文件 : " & Format((dbasize2 / 1024) / 1024, "standard") & "MB."
        cmdRestore.Enabled = True
    End If
Erro:
        Select Case err.Number
           Case 53 'File Not Found
              lblSelectedDba = "没有选择备份文件位置！"
              cmdRestore.Enabled = False
        End Select
End Sub

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

Private Sub Form_Load()
    PathName = App.Path & "\Student.MDB"
    On Error GoTo err
    dbasize = FileLen(PathName)
err:
    Exit Sub
End Sub

Public Sub DoRestore(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
    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 & "\Student.MDB" & vbNullChar
        .pTo = strDestinationPath & vbNullChar
        .fFlags = lFlags
    End With
    lresult = SHFileOperation(SHFileOp)
'    Set DB = New ADODB.Connection
'    DB.Open mclsMidTier.strConnString()
    Screen.MousePointer = vbDefault
    frmDatabaseRestore.lblStatus = "恢复数据库成功！"
End Sub