form1.frm

人事信息管理系统 VB毕业设计 原代码+论文

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form Frmdatabase 
   Caption         =   "数据操作"
   ClientHeight    =   4560
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   5190
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4560
   ScaleWidth      =   5190
   StartUpPosition =   3  '窗口缺省
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   4440
      Top             =   2280
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Cmd_Compact 
      Caption         =   "数据压缩"
      Height          =   615
      Left            =   960
      TabIndex        =   3
      Top             =   2400
      Width           =   3015
   End
   Begin VB.CommandButton Cmd_Restore 
      Caption         =   "数据恢复"
      Height          =   615
      Left            =   960
      TabIndex        =   2
      Top             =   1320
      Width           =   3015
   End
   Begin VB.CommandButton Cmd_Back 
      Caption         =   "退出"
      Height          =   615
      Left            =   960
      TabIndex        =   1
      Top             =   3600
      Width           =   3015
   End
   Begin VB.CommandButton Cmd_BackUp 
      Caption         =   "数据备份"
      Height          =   615
      Left            =   960
      TabIndex        =   0
      Top             =   360
      Width           =   3015
   End
End
Attribute VB_Name = "Frmdatabase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim newdb As String   '压缩后的数据库文件名
Dim olddb As String   '待压缩数据库文件名

Private Sub Cmd_Back_Click()
  Unload Me
End Sub

Private Sub Cmd_BackUp_Click()
  Dim Fs As FileSystemObject
  Dim BackUpFile As String
  olddb = App.Path + "\" + DATABASE
  BackUpFile = App.Path + "\Backup\" + Str(Date) + "_" + DATABASE
  If MsgBox("你确定要备份当前数据库吗？", vbQuestion + vbOKCancel _
                + vbDefaultButton2, "请确认") = vbCancel Then
    Exit Sub
  End If
  Set Fs = CreateObject("Scripting.FileSystemObject")
  '拷贝数据库文件至指定位置
  Fs.CopyFile olddb, BackUpFile
  MsgBox "数据库备份成功", vbInformation + vbOKOnly, "信息"
End Sub

Private Sub Cmd_Compact_Click()
  On Error GoTo Myerr
  Dim rdo As New JRO.JetEngine
  Dim strcnn_old As String
  Dim strcnn_new As String
  newdb = App.Path + "\temp.mdb"  ' 创建临时文件名
  olddb = App.Path + "\" + DATABASE
  '确认是否进行压缩处理
  If MsgBox("你确定要压缩当前数据库吗？", vbQuestion + vbOKCancel _
             + vbDefaultButton2, "请确认") = vbCancel Then
    Exit Sub
  End If
  '如果newdb存在，则删除
  If Dir(newdb) <> "" Then
    Kill newdb
  End If
  '设置连接字符串
  strcnn_old = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + olddb
  strcnn_new = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + newdb
  '先关闭全局连接
  DBapi_Disconnect
  '压缩数据库文件
  rdo.CompactDatabase strcnn_old, strcnn_new
  DoEvents    '考虑到连接是网络中的数据库时
  Kill olddb  '删除原来的文件
  Name newdb As olddb  '将压缩后的数据库文件名称改回去
  DB_Connect '再开启全局连接
  MsgBox "数据库压缩成功", vbInformation + vbOKOnly, "信息"
  Exit Sub
  '错误处理
Myerr:
  MsgBox Err.Number & Err.Description & Chr(13) _
           + "压缩数据库不成功，请关闭Access,重新登录系统", vbExclamation
  DB_Connect
End Sub

Private Sub Cmd_Restore_Click()
  CommonDialog1.ShowOpen
  newdb = CommonDialog1.FileName
  olddb = App.Path + "\" + DATABASE
  If MsgBox("你确定要恢复以前的数据库吗？这将导致新的数据丢失！", _
               vbQuestion + vbOKCancel + vbDefaultButton2, "小心！") = vbCancel Then
    Exit Sub
  End If
  '关闭数据库连接
  DBapi_Disconnect
  Kill olddb  '删除原来的文件
  Set Fs = CreateObject("Scripting.FileSystemObject")
  '拷贝数据库文件至指定位置
  Fs.CopyFile newdb, olddb
  DB_Connect '再开启全局连接
  MsgBox "数据库恢复成功", vbInformation + vbOKOnly, "信息"
End Sub