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