frmbackup.frm

朋友给的

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmBackup 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "数据备份"
   ClientHeight    =   1635
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6690
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   1635
   ScaleWidth      =   6690
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Frame2 
      Appearance      =   0  'Flat
      Caption         =   "复原数据库"
      ForeColor       =   &H80000008&
      Height          =   1350
      Left            =   105
      TabIndex        =   5
      Top             =   2235
      Width           =   6405
      Begin VB.CommandButton Command4 
         Caption         =   "选择路径/文件名"
         Height          =   450
         Left            =   2520
         TabIndex        =   8
         Top             =   750
         Width           =   1845
      End
      Begin VB.TextBox Text2 
         Appearance      =   0  'Flat
         Height          =   345
         Left            =   1215
         TabIndex        =   7
         Top             =   270
         Width           =   5040
      End
      Begin VB.CommandButton Command3 
         Caption         =   "复原数据库"
         Height          =   450
         Left            =   4395
         TabIndex        =   6
         Top             =   750
         Width           =   1845
      End
      Begin VB.Label Label2 
         Caption         =   "选择路径："
         Height          =   330
         Left            =   285
         TabIndex        =   9
         Top             =   360
         Width           =   1230
      End
   End
   Begin VB.Frame Frame1 
      Appearance      =   0  'Flat
      Caption         =   "备份数据库"
      ForeColor       =   &H80000008&
      Height          =   1350
      Left            =   135
      TabIndex        =   0
      Top             =   105
      Width           =   6405
      Begin MSComDlg.CommonDialog DLG 
         Left            =   885
         Top             =   915
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
      End
      Begin VB.CommandButton Command2 
         Caption         =   "备份数据库"
         Height          =   450
         Left            =   4395
         TabIndex        =   4
         Top             =   750
         Width           =   1845
      End
      Begin VB.TextBox Text1 
         Appearance      =   0  'Flat
         Height          =   345
         Left            =   1215
         TabIndex        =   2
         Top             =   270
         Width           =   5040
      End
      Begin VB.CommandButton Command1 
         Caption         =   "选择路径/文件名"
         Height          =   450
         Left            =   2520
         TabIndex        =   1
         Top             =   750
         Width           =   1845
      End
      Begin VB.Label Label1 
         Caption         =   "选择路径："
         Height          =   330
         Left            =   285
         TabIndex        =   3
         Top             =   360
         Width           =   1230
      End
   End
End
Attribute VB_Name = "frmBackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
   On Error GoTo ExitNow
   Dim filedir As String
'   Dim Filename As String
   Dim fso As New FileSystemObject
   Dim DestPFld As Scripting.Folder, DestFld As Scripting.Folder
    With DLG
        .Filename = "QSerp" & Format(Date, "yyyymmdd")
        .Filter = "*.*" & "|" & "*.*"
        .ShowOpen
        If .Filename <> "" Then
            If .Filename <> "" Then
                Text1.Text = .Filename
                
            End If
        End If
    End With
   

ExitNow:
End Sub

Private Sub Command2_Click()
    
Dim strFileName As String
'Dim fso As New FileSystemObject
Dim strPsaa As String
On Error Resume Next
   If Text1.Text = "" Then: Exit Sub
'    If Forms.count > 2 Then MsgBox "请关闭所有在用窗体，数据备份时必须保证没有人在使用数据库！", vbCritical, "系统提示": Exit Sub
    If MsgBox("你确定要备份现有数据库吗？", vbInformation + vbOKCancel, "系统提示") = vbCancel Then Exit Sub
    
    MsgBox "备份数据库，可能需要几分钟时间，请点击确定后耐心等待", vbInformation, "系统提示"
'    DoEvents
    
    strPsaa = Text1.Text '"D:\backup\hotel" & Format(Date, "yyyymmdd")
    gCnn.Execute "BackUp DataBase Qserp To Disk='" & strPsaa & "' with Init"
    MsgBox "数据库备份成功，备份数据保存在服务器的“" & strPsaa & "”中！", vbInformation, "系统提示"
End Sub

Private Sub Command3_Click()
    If Text2.Text = "" Then: Exit Sub
    MsgBox "恢复数据库操作过于危险，容易造成数据丢失，请与管理员联系！", vbInformation, "系统提示"
'    Dim strFileName As String
'    Dim fso As New FileSystemObject
'    On Error GoTo errlabell
'        If Forms.count > 2 Then MsgBox "请关闭所有在用窗体，数据恢复时必须保证没有人在使用数据库！", vbCritical, "系统提示": Exit Sub
'        If MsgBox("你确定要恢复数据库改变现有数据吗？", vbInformation + vbOKCancel, "系统提示") = vbCancel Then Exit Sub
'        strFileName = App.Path & "\Working.avi"
'        If Not fso.FileExists(strFileName) Then MsgBox "动画文件(Working.avi)不存在！", vbCritical, "系统提示": Exit Sub
'
'        StatusBar1.Panels(2) = "正在恢复数据库，需要几分钟时间，请梢候......"
'        frmProcBar.Caption = "数据库恢复"
'        frmProcBar.Show
'        frmProcBar.Animation1.Open strFileName
'        frmProcBar.Animation1.Play
'        DoEvents
'
'        gCnn.Execute "Use Master"
'        gCnn.Execute "Restore DataBase jxsdatabase from Disk='d:\ComputerBase' "
'        gCnn.Execute "Use " & gCnn.Database
'
'        frmProcBar.Animation1.Close
'        Unload frmProcBar
'        StatusBar1.Panels(2) = "数据库恢复完毕！"
'        Set fso = Nothing
'        Exit Sub
'errlabell:
'        MsgBox "数据库恢复失败，数据库可能已损坏，请与管理员联系！" & Err.Description, vbCritical, "严重错误"
'        StatusBar1.Panels(2) = "数据库恢复失败，数据库可能已损坏，请与管理员联系！" & Err.Description
    
End Sub

Private Sub Command4_Click()
   On Error GoTo ExitNow
   Dim filedir As String
   Dim Filename As String
   Dim fso As New FileSystemObject
   Dim DestPFld As Scripting.Folder, DestFld As Scripting.Folder
   
   DLG.Filter = "所有文件|*.*"
   DLG.FilterIndex = 2
   DLG.DialogTitle = "选择源文件!"
   DLG.CancelError = True
   DLG.ShowOpen
   Filename = DLG.Filename
   Text2.Text = Filename
   

ExitNow:
End Sub

Private Sub Form_Load()
If Me.WindowState = 0 Then Me.Move 0, 0
End Sub