repair.frm

酒店管理系统

VERSION 5.00
Object = "{50CBA22D-9024-11D1-AD8F-8E94A5273767}#8.6#0"; "TRANIMG2.OCX"
Begin VB.Form REPAIR 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "数据库维护工具"
   ClientHeight    =   1770
   ClientLeft      =   690
   ClientTop       =   1740
   ClientWidth     =   5280
   ControlBox      =   0   'False
   Icon            =   "REPAIR.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1770
   ScaleWidth      =   5280
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   1200
      Top             =   720
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   600
      Top             =   720
   End
   Begin VB.CommandButton Command1 
      Caption         =   "取消(&C)"
      Height          =   375
      Index           =   2
      Left            =   3360
      TabIndex        =   4
      Top             =   1080
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "优化(&Z)"
      Height          =   375
      Index           =   1
      Left            =   2160
      TabIndex        =   3
      Top             =   1080
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "修复(&R)"
      Height          =   375
      Index           =   0
      Left            =   960
      TabIndex        =   2
      Top             =   1080
      Width           =   975
   End
   Begin DevPowerTransImg.TransImg TransImg1 
      Height          =   495
      Left            =   8880
      TabIndex        =   0
      Top             =   680
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   873
      AutoSize        =   0   'False
      MaskColor       =   16777215
      Transparent     =   -1  'True
   End
   Begin VB.Label Label1 
      Caption         =   "注意：为保证数据安全，在修复或优化数据库之前请关闭       当前正在使用的所有功能模块，并作必要的为数据       库备份。"
      Height          =   735
      Left            =   360
      TabIndex        =   1
      Top             =   240
      Width           =   4575
   End
End
Attribute VB_Name = "REPAIR"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click(Index As Integer)
    Select Case Index
    Case 0
        Load JBBWIN1
        JBBWIN1.Label1.Caption = "请稍候!正在修复数据库..."
        JBBWIN1.Show
        Timer1.Enabled = True
    Case 1
        Load JBBWIN1
        JBBWIN1.Label1.Caption = "请稍候!正在优化数据库..."
        JBBWIN1.Show
        Timer2.Enabled = True
    Case 2
        Unload Me
    End Select
End Sub

Private Sub Form_Load()
'    Me.Hide
End Sub

Private Sub Timer1_Timer()
    On Error GoTo EXITERROR
    
    Timer1.Enabled = False
    
    ' 关闭数据库对象并且释放内存
    Dim ws As Workspace
    Dim db As Database
    Dim rs As Recordset

    For Each ws In Workspaces
        For Each db In ws.Databases
            For Each rs In db.Recordsets
                rs.Close
                Set rs = Nothing
            Next
            db.Close
            Set db = Nothing
        Next
        ws.Close
        Set ws = Nothing
    Next
    
    DBEngine.RepairDatabase App.Path & "\DATA\JDGL.MDB"
    JBBWIN1.ProgressBar1.Value = JBBWIN1.ProgressBar1.Max
    MsgBox "数据库已成功修复!", vbInformation, "提示信息"
    Unload Me
    Exit Sub
    
EXITERROR:
    MsgBox CStr(Err.Number) & "-" & Err.Description & "修复失败!", vbCritical, "错误信息"
    Unload JBBWIN1
    Unload Me
    Exit Sub

End Sub
Private Sub Timer2_Timer()
    On Error GoTo EXITERROR
    
    Timer2.Enabled = False
    
    ' 关闭数据库对象并且释放内存
    Dim ws As Workspace
    Dim db As Database
    Dim rs As Recordset

    For Each ws In Workspaces
        For Each db In ws.Databases
            For Each rs In db.Recordsets
                rs.Close
                Set rs = Nothing
            Next
            db.Close
            Set db = Nothing
        Next
        ws.Close
        Set ws = Nothing
    Next
    
    DBEngine.CompactDatabase App.Path & "\DATA\JDGL.MDB", App.Path & "\DATA\JDGL.CAT"
    FileCopy App.Path & "\DATA\JDGL.CAT", App.Path & "\DATA\JDGL.MDB"
    Kill App.Path & "\DATA\JDGL.CAT"
    JBBWIN1.ProgressBar1.Value = JBBWIN1.ProgressBar1.Max
    MsgBox "数据库已成功优化!", vbInformation, "提示信息"
    Unload Me
    Exit Sub
    
EXITERROR:
    MsgBox CStr(Err.Number) & "-" & Err.Description & Chr(13) & "优化失败!", vbCritical, "错误信息"
    Unload JBBWIN1
    Unload Me
    Exit Sub

End Sub