企业管理

开发平台：
Visual Basic

frmDBMgr.frm：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmDBMaintain 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "数据库维护"
   ClientHeight    =   3210
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7500
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmDBMgr.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3210
   ScaleWidth      =   7500
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.TextBox txtDataFile 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   1080
      Locked          =   -1  'True
      TabIndex        =   7
      Top             =   480
      Width           =   4155
   End
   Begin VB.CommandButton cmdexit 
      Caption         =   "退 出(&Q)"
      Height          =   375
      Left            =   5880
      TabIndex        =   6
      Top             =   1440
      Width           =   1095
   End
   Begin VB.CommandButton cmdBackupDB 
      Caption         =   "备 份(&B)"
      Height          =   375
      Left            =   5880
      TabIndex        =   5
      Top             =   960
      Width           =   1095
   End
   Begin VB.CommandButton pathSel 
      Caption         =   "选 择(&S)"
      Height          =   375
      Left            =   5880
      TabIndex        =   4
      Top             =   480
      Width           =   1095
   End
   Begin VB.TextBox txtBakDir 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   1080
      Locked          =   -1  'True
      TabIndex        =   1
      Top             =   960
      Width           =   4155
   End
   Begin VB.Frame Frame1 
      Caption         =   "数据库备份"
      ForeColor       =   &H000040C0&
      Height          =   1155
      Left            =   240
      TabIndex        =   0
      Top             =   1920
      Width           =   5175
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "    为了防止机器或硬盘出现无法恢复的错误，请定期使用“数据库备份”将到目前为止的所有旅客信息和房间信息备份至指定目录。"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   720
         Left            =   120
         TabIndex        =   2
         Top             =   240
         Width           =   4995
         WordWrap        =   -1  'True
      End
   End
   Begin MSComctlLib.ImageList imgTab 
      Left            =   4680
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483644
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmDBMgr.frx":0442
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmDBMgr.frx":0894
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmDBMgr.frx":0CE6
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmDBMgr.frx":1138
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComDlg.CommonDialog dlgPath 
      Left            =   4080
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DefaultExt      =   "mdb"
      DialogTitle     =   "请指定备份数据库路径"
      FileName        =   "*.mdf"
      Filter          =   "数据文件(*.mdf)|*.mdb"
      FontName        =   "宋体"
      FontSize        =   9
      InitDir         =   "..dbbak"
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "数据文件"
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   120
      TabIndex        =   8
      Top             =   480
      Width           =   840
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "备份目录"
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   120
      TabIndex        =   3
      Top             =   960
      Width           =   840
   End
End
Attribute VB_Name = "frmDBMaintain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim dbRec1 As Recordset
Dim dbRec2 As Recordset
Dim dbRec3 As Recordset
Dim tmpPath As String
Private Sub cmdBackupDB_Click()
On Error GoTo BackupDBErr
Dim MyMdb As String
If MsgBox("现在就开始数据库备份吗？", vbInformation + vbYesNo, "提  示") = vbYes Then
Me.MousePointer = 11
Call DataBack
MsgBox "数据库备份完毕！请妥善保存备份文件，这些文件可用于恢复数据库 ！", vbInformation, "提 示"
End If
    Me.MousePointer = 0
    On Error GoTo 0
    Exit Sub
BackupDBErr:
    MsgBox "发生错误,现在将退出系统,请在重新进入系统后再备份数据库。具体错误详细描述如下：" & Err.Description, vbInformation, "提  示"
    Me.MousePointer = 0
    Unload Me
End Sub
Private Sub DataBack()
    On Error GoTo RestoreDBErr
    
        If Dir(Trim(txtBakDir.Text), vbDirectory) = "" Then
            If MsgBox("您指定的目录不存在，如果您想建立该目录，并把最近一次的备份文件拷贝至该目录下，请选择确定；否则选择取消重新指定目录。", vbInformation + vbOKCancel, "提  示") = vbOK Then
                MkDir Trim(txtBakDir.Text)
            End If
            Exit Sub
        End If
    
            FileCopy Trim(Me.txtDataFile.Text), Trim(Me.txtBakDir)
            
    
        MsgBox "数据库恢复完毕！", vbInformation, "提 示"
        
        End
    
    Exit Sub
RestoreDBErr:
    MsgBox "发生错误,现在将退出系统,请在重新进入系统后再备份数据库。错误详细描述如下：" & Err.Description, vbInformation, "提  示"
End Sub
Private Sub cmdexit_Click()
    Unload Me
End Sub
Private Sub pathSel_Click()
dlgPath.Flags = cdlOFNHideReadOnly Or cdlOFNOverwritePrompt
dlgPath.FileName = tmpPath
dlgPath.ShowOpen
If Trim(dlgPath.FileName) <> "" Then
    tmpPath = dlgPath.FileName
End If
Me.txtDataFile = Trim(tmpPath)
End Sub
Private Sub Form_Load()
    If Dir(App.Path & "bak", vbDirectory) = "" Then CreateDir ("bak")
    txtBakDir.Text = App.Path & "BAK"
    If UserInfo.QX = 1 Then
        Me.cmdBackupDB.Enabled = False
        Me.pathSel.Enabled = False
    End If
    Me.txtDataFile = "D:Program FilesMicrosoft SQL ServerMSSQLData"
End Sub
Public Sub CreateDir(Dir As String)
    MkDir App.Path & "" & Dir
End Sub
Private Sub txtBakDir_GotFocus()
    txtBakDir.SelStart = 0
    txtBakDir.SelLength = Len(txtBakDir.Text)
End Sub

						