frmbackup.frm

这是一个银行IC卡门禁系统软件

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{065E6FD1-1BF9-11D2-BAE8-00104B9E0792}#3.0#0"; "SSA3D30.OCX"
Object = "{8C3D4AA0-2599-11D2-BAF1-00104B9E0792}#3.0#0"; "SSSPLT30.OCX"
Begin VB.Form frmBackup 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "数据备份"
   ClientHeight    =   2565
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5715
   Icon            =   "frmBackup.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2565
   ScaleWidth      =   5715
   ShowInTaskbar   =   0   'False
   Begin SSSplitter.SSSplitter SSSplitter1 
      Height          =   2565
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5715
      _ExtentX        =   10081
      _ExtentY        =   4524
      _Version        =   196610
      AutoSize        =   1
      BorderStyle     =   0
      PaneTree        =   "frmBackup.frx":000C
      Begin Threed.SSPanel SSPanel1 
         Height          =   2565
         Left            =   0
         TabIndex        =   1
         Top             =   0
         Width           =   5715
         _ExtentX        =   10081
         _ExtentY        =   4524
         _Version        =   196610
         BevelInner      =   1
         RoundedCorners  =   0   'False
         FloodShowPct    =   -1  'True
         Begin Threed.SSCommand cmdExit 
            Height          =   405
            Left            =   4350
            TabIndex        =   2
            Top             =   1290
            Width           =   1095
            _ExtentX        =   1931
            _ExtentY        =   714
            _Version        =   196610
            PictureFrames   =   1
            BackStyle       =   1
            BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
               Name            =   "宋体"
               Size            =   9.75
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Picture         =   "frmBackup.frx":0040
            Caption         =   "直接退出"
            Alignment       =   4
            ButtonStyle     =   3
            PictureAlignment=   1
         End
         Begin Threed.SSCommand cmdBackup 
            Height          =   405
            Left            =   4350
            TabIndex        =   3
            Top             =   600
            Width           =   1095
            _ExtentX        =   1931
            _ExtentY        =   714
            _Version        =   196610
            PictureFrames   =   1
            BackStyle       =   1
            BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
               Name            =   "宋体"
               Size            =   9.75
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Picture         =   "frmBackup.frx":019A
            Caption         =   "备份退出"
            Alignment       =   4
            ButtonStyle     =   3
            PictureAlignment=   1
         End
         Begin Threed.SSFrame SSFrame1 
            Height          =   2085
            Left            =   270
            TabIndex        =   4
            Top             =   270
            Width           =   3465
            _ExtentX        =   6112
            _ExtentY        =   3678
            _Version        =   196610
            BackStyle       =   1
            Begin VB.Label Label1 
               BackStyle       =   0  'Transparent
               Caption         =   "    数据备份是数据维护的重要步骤，推荐你每天或每次退出软件时，对数据库进行备份。以便在计算机突然发生故障时能恢复数据。"
               BeginProperty Font 
                  Name            =   "宋体"
                  Size            =   9.75
                  Charset         =   134
                  Weight          =   400
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               Height          =   1815
               Left            =   360
               TabIndex        =   5
               Top             =   210
               Width           =   2715
            End
         End
         Begin MSComDlg.CommonDialog CD 
            Left            =   3840
            Top             =   1080
            _ExtentX        =   847
            _ExtentY        =   847
            _Version        =   393216
         End
      End
   End
End
Attribute VB_Name = "frmBackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'##ModelId=3D3384D8001A
Private Sub cmdBackup_Click()
    '<EhHeader>
    On Error GoTo cmdBackup_Click_Err
    '</EhHeader>

    Dim AccessPath As String
    Dim cnnstr As String
    Dim cnnstr2 As String
    Dim FileName As String
    Dim BackupfileName As String
    
    Dim fso As New FileSystemObject
    Dim fCompact As File
    Dim fOriginal As File
    Dim fBackup As File
    Dim myJro As New JRO.JetEngine
    
    AccessPath = GetSetting("LockDB", "CnnServer", "AccessPath", "")
    
    FileName = Right(AccessPath, Len(AccessPath) - InStrRev(AccessPath, "\"))
    
    Set dbcnn = New LockDBConnection
    Set cnnLock = dbcnn.cnn
    
    cnnstr = cnnLock.ConnectionString
    
    cnnstr2 = Replace(cnnstr, FileName, "~" & FileName, , , vbTextCompare)

    Set cnnLock = Nothing
    Set dbcnn = Nothing

    If FileExists(Replace(AccessPath, FileName, "~" & FileName)) Then

        Set fCompact = fso.GetFile(Replace(AccessPath, FileName, "~" & FileName))
        fCompact.Delete
        Set fCompact = Nothing
        
        myJro.CompactDatabase cnnstr, cnnstr2
        
        Set fOriginal = fso.GetFile(AccessPath)
        fOriginal.Delete
        
        Set fCompact = fso.GetFile(Replace(AccessPath, FileName, "~" & FileName))
        fCompact.Copy (AccessPath)
        fCompact.Delete
        
    Else

        myJro.CompactDatabase cnnstr, cnnstr2
        
        Set fOriginal = fso.GetFile(AccessPath)
        fOriginal.Delete
        
        Set fCompact = fso.GetFile(Replace(AccessPath, FileName, "~" & FileName))
        fCompact.Copy (AccessPath)
        fCompact.Delete
        
    End If

    Set fCompact = Nothing
    Set fOriginal = Nothing
    
    If Not fso.FolderExists(App.Path & "\Backup") Then

        fso.CreateFolder (App.Path & "\Backup")

    End If
    
    CD.InitDir = App.Path & "\Backup"
    CD.DialogTitle = "备份互锁联动数据库..."
    CD.Filter = "MS Access 97/2000(*.MDB)|*.MDB"
    
    CD.FileName = Replace(FileName, ".", Format(Now, "yyyy-mm-dd") & ".")
    
    CD.ShowSave
    
    If FileExists(CD.FileName) Then

        Set fOriginal = fso.GetFile(CD.FileName)
        fOriginal.Delete

    End If
    
    Set fBackup = fso.GetFile(AccessPath)

    fBackup.Copy (CD.FileName)
    
    SaveSetting "LockDB", "CnnServer", "BackupPath", CD.FileName
    
    Unload Me

    '<EhFooter>
    Exit Sub

cmdBackup_Click_Err:
    LockErrorShow

    '</EhFooter>
    '</EhFooter>

End Sub

'##ModelId=3D3384D80088
Private Sub cmdExit_Click()

    Unload Me

End Sub

'##ModelId=3D3384D800CE
Private Sub Form_Load()

    Me.Top = (Screen.Height - Me.Height) / 2 - 500
    Me.Left = (Screen.Width - Me.Width) / 2 - 500

    SSPanel1.PictureBackground = mainForm.Pic.Picture
    SSPanel1.PictureBackgroundStyle = ssTiled

End Sub