frm_databasecare.frm

汽修厂管理软件

VERSION 5.00
Begin VB.Form Frm_DataBaseCare 
   Caption         =   "数据库维护...建议每天备份数据库!"
   ClientHeight    =   2700
   ClientLeft      =   5115
   ClientTop       =   3795
   ClientWidth     =   6915
   Icon            =   "frm_DataBaseCare.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2700
   ScaleWidth      =   6915
   Begin VB.CommandButton Cmd_Exit 
      Caption         =   "退出"
      Height          =   255
      Left            =   240
      TabIndex        =   6
      Top             =   2040
      Width           =   1455
   End
   Begin VB.CommandButton Cmd_RepairDataBase 
      Caption         =   "修复数据库"
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   1440
      Width           =   1455
   End
   Begin VB.CommandButton Cmd_HuanYuan 
      Caption         =   "还原数据库"
      Enabled         =   0   'False
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   840
      Width           =   1455
   End
   Begin VB.TextBox txt_BackUpPath 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   1920
      TabIndex        =   1
      ToolTipText     =   "完整路径和文件名"
      Top             =   240
      Width           =   4215
   End
   Begin VB.CommandButton Cmd_BackUp 
      Caption         =   "备份数据库至"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   1455
   End
   Begin VB.Label Label3 
      Caption         =   ",会覆盖当前数据库!"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   4440
      TabIndex        =   7
      Top             =   840
      Width           =   1695
   End
   Begin VB.Label Label2 
      Caption         =   "如果数据库发生错误,使用该功能,但可能会丢失数据!"
      Height          =   375
      Left            =   1920
      TabIndex        =   5
      Top             =   1440
      Width           =   4335
   End
   Begin VB.Label Label1 
      Caption         =   "将以前备份的数据资料重新使用"
      Height          =   255
      Left            =   1920
      TabIndex        =   3
      Top             =   840
      Width           =   2535
   End
End
Attribute VB_Name = "Frm_DataBaseCare"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Cmd_Backup_Click()
'On Error GoTo EHand
 Dim nKeyHandle As Long, nValueType As Long, nLength As Long
 Dim sValue As String
  
 Set fs = CreateObject("Scripting.FileSystemObject")
 'Set a = fs.CreateTextFile(DBPATH, True)
   
   '写注册表
   Call RegCreateKey(HKEY_LOCAL_MACHINE, "SoftWare\HussarWorkRoom", nKeyHandle)
   nLength = Len(txt_BackUpPath.Text)
   Call RegSetValueEx(nKeyHandle, "BackupPath", 0, REG_SZ, txt_BackUpPath.Text, 255)
   Call RegCloseKey(nKeyHandle)
'备份:
  
  fs.copyfile DBPATH, txt_BackUpPath.Text, True
  MsgBox "已成功备份数据库资料!", vbInformation, STRGARAGE
  Exit Sub
  
EHand:
 MsgBox Err.Description, vbInformation + vbOKOnly, STRGARAGE
End Sub

Private Sub Cmd_Backup_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Cmd_BackUp.Font.Bold = True
End Sub

Private Sub Cmd_Exit_Click()
Unload Me
End Sub

Private Sub Cmd_Exit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Cmd_Exit.Font.Bold = True
End Sub

Private Sub Cmd_HuanYuan_Click()
FileSystemObject.Copy txt_BackUpPath.Text, DBPATH, True
End Sub

Private Sub Cmd_HuanYuan_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Cmd_HuanYuan.Font.Bold = True
End Sub

Private Sub Cmd_RepairDataBase_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Cmd_RepairDataBase.Font.Bold = True

End Sub

Private Sub Form_Load()
Dim nKeyHandle As Long, nValueType As Long, nLength As Long
   Dim sValue As String
   sValue = Space(255)
    
    Call RegCreateKey(HKEY_LOCAL_MACHINE, "Software\HussarWorkRoom", nKeyHandle)
    Call RegQueryValueEx(nKeyHandle, "BackUpPath", 0, nValueType, sValue, 255)
    txt_BackUpPath.Text = sValue
    
    Call RegCloseKey(nKeyHandle)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Dim objLoop As Object
  For Each objLoop In Me
   If TypeName(objLoop) = "CommandButton" Then objLoop.Font.Bold = False
  Next objLoop
End Sub