databackup.frm

CELL-ID技术是目前最简单的定位技术

VERSION 5.00
Begin VB.Form 数据库备份 
   Caption         =   "数据库备份与恢复"
   ClientHeight    =   3735
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   5370
   Icon            =   "databackup.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "databackup.frx":6852
   ScaleHeight     =   3735
   ScaleWidth      =   5370
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox Text1 
      Appearance      =   0  'Flat
      Height          =   615
      Left            =   240
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   5
      ToolTipText     =   "数据库备份、恢复路径"
      Top             =   3000
      Width           =   4935
   End
   Begin VB.CommandButton Command2 
      Caption         =   "数据恢复"
      Height          =   615
      Left            =   4200
      TabIndex        =   4
      Top             =   360
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "数据备份"
      Height          =   615
      Left            =   2880
      TabIndex        =   3
      Top             =   360
      Width           =   1095
   End
   Begin VB.FileListBox File1 
      Height          =   1530
      Left            =   2880
      Pattern         =   "*.BAK"
      TabIndex        =   2
      Top             =   1200
      Width           =   2295
   End
   Begin VB.DirListBox Dir1 
      Height          =   1560
      Left            =   240
      TabIndex        =   1
      Top             =   1200
      Width           =   2535
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   240
      TabIndex        =   0
      Top             =   720
      Width           =   2535
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "注意："
      Height          =   180
      Left            =   840
      TabIndex        =   7
      Top             =   120
      Width           =   540
   End
   Begin VB.Label Label1 
      Caption         =   "请勿将数据备份至硬盘根目录！"
      Height          =   420
      Left            =   1440
      TabIndex        =   6
      Top             =   120
      Width           =   1425
   End
End
Attribute VB_Name = "数据库备份"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private rs As New ADODB.Recordset
Private Rs_user As New ADODB.Recordset
Private str As String


Private Sub Command1_Click()

  If Text1.Text = "" Then
     MsgBox "备份数据库路径不能为空！"
     Exit Sub
  End If
  Dim F As String
  F = Text1.Text & "\" & Format(Date, "YYYY-MM-DD") & "_" & Format(Time, "hh-mm-ss") & ".BAK"
  Call cnn
  Set rs = New ADODB.Recordset
  str = "BACKUP DATABASE " & data_name & " TO DISK ='" & F & " '"
   'Connection 对象的 Execute 方法，执行指定的查询、SQL 语句、存储过程或特定提供者的文本等内容。
  Set rs = cnn.Execute(str)
  MsgBox "数据库备份成功！"
  cnn.Close

End Sub


Private Sub Command2_Click()

  If Text1.Text = "" Then
     MsgBox "请选择数据恢复文件！"
     Exit Sub
  End If
  On Error GoTo Er01
  Call cnn
  Set rs = New ADODB.Recordset
  cnn.Execute ("Alter DATABASE " & data_name & " set single_user with rollback immediate use master RESTORE DATABASE " & data_name & " from disk='" + Text2.Text + "'")
  str = "Alter DATABASE " & data_name & " set multi_user"
   'Connection 对象的 Execute 方法，执行指定的查询、SQL 语句、存储过程或特定提供者的文本等内容。
  Set rs = cnn.Execute(str)
  MsgBox "数据库恢复成功！"
  cnn.Close
  Exit Sub
Er01:
  MsgBox "由于系统数据量大,数据库恢复已经超时,请退出系统从新操作数据备份!!!", , "系统提示"
  cnn.Close
  End

End Sub



Private Sub Dir1_Change()
  File1.Path = Dir1.Path
End Sub

Private Sub Dir1_Click()
  Text1.Text = Dir1.Path
End Sub
Private Sub Drive1_Change()
On Error GoTo error1
  Dir1.Path = Drive1.Drive
  
error1:    '错误处理
If Err.Number = 68 Then MsgBox "不能打开此存储设备！"
  'MsgBox "不能打开此存储设备！" & Err.Description & "错误代码" & Err.Number
   
End Sub


Private Sub File1_Click()
  If Mid(File1.FileName, 20, 23) <> ".BAK" Then
     MsgBox "请您选择拓展名为‘.BAK’的文件为合法文件"
     Exit Sub
  End If
  Text1.Text = Dir1.Path & "\" & File1.FileName
End Sub

Private Sub Form_Load()
  ClassIni.IniFileName = App.Path & "\Config\database.ini"
  data_name = ClassIni.ReadString("Database", "databasename", 9999)
End Sub


Private Sub Form_Unload(Cancel As Integer)
  系统主窗口.Enabled = True
End Sub