frmbackup.frm

这是基于MapX4.0的房屋测绘管理信息系统

VERSION 5.00
Begin VB.Form frmBackup 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "备份数据库"
   ClientHeight    =   3015
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   5220
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3015
   ScaleWidth      =   5220
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdBrowse 
      Caption         =   "浏览(&B)..."
      Height          =   435
      Left            =   2955
      TabIndex        =   5
      Top             =   885
      Width           =   1260
   End
   Begin VB.CheckBox chkPath 
      Caption         =   "选择默认目录(&M)"
      Height          =   195
      Left            =   165
      TabIndex        =   4
      Top             =   1005
      Width           =   2085
   End
   Begin VB.TextBox txtPath 
      Height          =   270
      Left            =   150
      TabIndex        =   2
      Top             =   360
      Width           =   4740
   End
   Begin VB.CommandButton CancelCmd 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   435
      Left            =   2970
      TabIndex        =   1
      Top             =   2145
      Width           =   1260
   End
   Begin VB.CommandButton OKCmd 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   435
      Left            =   990
      TabIndex        =   0
      Top             =   2145
      Width           =   1260
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "选择的备份目录(&P)："
      Height          =   180
      Left            =   150
      TabIndex        =   3
      Top             =   120
      Width           =   1710
   End
End
Attribute VB_Name = "frmBackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mPath As String '备份路径
Private Sub CancelCmd_Click()
    mPath = ""
    Unload Me
End Sub
Private Sub chkPath_Click()
    If chkPath.Value = 1 Then 'checked
        txtPath.Enabled = False
        txtPath = BK_PATH
        txtPath.Enabled = False
        cmdBrowse.Enabled = False
    Else
        txtPath.Enabled = True
        txtPath.Enabled = True
        cmdBrowse.Enabled = True
    End If
End Sub
Private Sub cmdBrowse_Click()
    Dim cjd As CJDFun.CFunction
    
    On Error Resume Next
    Set cjd = New CJDFun.CFunction
    txtPath = cjd.BrowseForFolder(Me.hwnd)
    If Not cjd Is Nothing Then
        Set cjd = Nothing
    End If
End Sub
'返回备份路径
Public Property Get BackupPath() As String
    BackupPath = mPath
End Property
Private Sub OKCmd_Click()
    On Error Resume Next
    
    Dim bSelected As Boolean
    Dim fs As Scripting.FileSystemObject
    Dim ret As VbMsgBoxResult
    
    bSelected = False
    If chkPath.Value = 1 Then 'checked
        mPath = BK_PATH
        bSelected = True
    Else 'unchecked
        Set fs = CreateObject("Scripting.FileSystemObject")
        
        mPath = txtPath
        If mPath = "" Then '如果没有选择路径
            MsgBox "请选择备份路径！", vbOKOnly + vbInformation, Me.Caption
        Else
            If Right(mPath, 1) <> "\" Then
                mPath = mPath & "\"
            End If
            If mPath = DATABASE_PATH Then '与数据库的路径相同
                mPath = mPath & "backup\"
                bSelected = True
            Else
                '判断是否所选目录存在
                If Not fs.FolderExists(mPath) Then '不存在
                    ret = MsgBox("你所输入的备份路径" & vbCrLf & mPath & vbCrLf & "不存在。" & vbCrLf & _
                                 "确定要创建一个新的子目录吗?", vbOKCancel + vbQuestion, Me.Caption)
                                 
                    On Error GoTo ErrHandler

                    If ret = vbOK Then
                        Dim path As String
                        
                        path = fs.GetParentFolderName(mPath)
                        fs.CreateFolder mPath
                    Else
                        Exit Sub
                    End If
                End If
                
                bSelected = True
            End If
        End If
    End If
    
    If bSelected Then
        Unload Me
    End If
    
    Exit Sub
ErrHandler:
    Dim msg As String
    msg = Me.Name & ":OKCmd_Click()" & vbCrLf & vbCrLf & _
        "错误#" & CStr(Err.Number) & ":子目录无法创建！" & vbCrLf & vbCrLf & _
        "原因可能是，你所选择的目录格式不正确" & vbCrLf & _
        "           或者是选择的子目录的父目录不存在。"
    MsgBox msg, vbOKOnly + vbExclamation, Me.Caption
    
    '写入日志
    WriteToLog (msg)
End Sub