repair.frm

《VB6数据库开发指南》所有的例程的源码

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   BackColor       =   &H00C0C0C0&
   Caption         =   "Database Maintenance"
   ClientHeight    =   1950
   ClientLeft      =   1875
   ClientTop       =   1665
   ClientWidth     =   3930
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1950
   ScaleWidth      =   3930
   Begin VB.CommandButton cmdClose 
      Cancel          =   -1  'True
      Caption         =   "&Close"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   555
      Left            =   2580
      TabIndex        =   4
      Top             =   1260
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "&OK"
      Default         =   -1  'True
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   555
      Left            =   1200
      TabIndex        =   3
      Top             =   1260
      Width           =   1215
   End
   Begin VB.Frame grpOperation 
      BackColor       =   &H00C0C0C0&
      Caption         =   "Operation"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1035
      Left            =   90
      TabIndex        =   0
      Top             =   30
      Width           =   3705
      Begin VB.OptionButton optRepair 
         BackColor       =   &H00C0C0C0&
         Caption         =   "Repair a database"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Left            =   120
         TabIndex        =   2
         Top             =   600
         Width           =   2925
      End
      Begin VB.OptionButton optCompact 
         BackColor       =   &H00C0C0C0&
         Caption         =   "Compact a database"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   300
         Value           =   -1  'True
         Width           =   2925
      End
   End
   Begin MSComDlg.CommonDialog cdlDatabase 
      Left            =   120
      Top             =   1950
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   327680
      CancelError     =   -1  'True
      DefaultExt      =   "MDB"
      FileName        =   "*.MDB"
      Filter          =   "MDB Files|*.MDB|All Files|*.*"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdClose_Click()
    End
End Sub

Private Sub cmdOK_Click()
    Dim strInput As String, strOutput As String
    
    On Error GoTo OKError
        With cdlDatabase
            .DialogTitle = "Select File To " & _
                IIf(optCompact, "Compact", "Repair")
            .ShowOpen
        End With
        strInput = cdlDatabase.filename
        
        If optCompact Then
            With cdlDatabase
                .DialogTitle = "Repaired Filename"
                .filename = ""
                .ShowSave
            End With
            strOutput = cdlDatabase.filename
            Screen.MousePointer = vbHourglass
            DBEngine.CompactDatabase strInput, strOutput
            Screen.MousePointer = vbDefault
            MsgBox "Database " & strInput & " compacted to " & strOutput
        Else
            Screen.MousePointer = vbHourglass
            DBEngine.RepairDatabase strInput
            Screen.MousePointer = vbDefault
            MsgBox "Repair of " & strInput & " successful."
        End If
    On Error GoTo 0
Exit Sub

OKError:
    Screen.MousePointer = vbDefault
    If Err <> 32755 Then MsgBox Err.Description
Exit Sub
    
End Sub