📄 dlgdatabasebackup.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form dlgDatabaseBackup
BorderStyle = 1 'Fixed Single
Caption = "数据库备份"
ClientHeight = 3360
ClientLeft = 45
ClientTop = 330
ClientWidth = 4920
Icon = "dlgDatabaseBackup.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3360
ScaleWidth = 4920
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton cmdQuit
Caption = "取消(&C)"
Height = 375
Left = 3720
TabIndex = 10
Top = 2800
Width = 975
End
Begin VB.CommandButton cmdOk
Caption = "确定(&O)"
Height = 375
Left = 2760
TabIndex = 9
Top = 2800
Width = 975
End
Begin VB.Frame Frame1
Caption = "备份类型"
Height = 855
Left = 240
TabIndex = 6
Top = 1800
Width = 4455
Begin VB.OptionButton optDiff
Caption = "增量备份"
Height = 375
Left = 2520
TabIndex = 8
Top = 300
Width = 1215
End
Begin VB.OptionButton optFull
Caption = "完全备份"
Height = 375
Left = 720
TabIndex = 7
Top = 300
Width = 1215
End
End
Begin VB.Frame Frame2
Caption = "备份文件"
Height = 1455
Left = 240
TabIndex = 0
Top = 120
Width = 4455
Begin VB.CheckBox chkOverWrite
BackColor = &H00E0E0E0&
Height = 255
Left = 480
TabIndex = 3
Top = 840
Width = 255
End
Begin VB.CommandButton cmdOpenFile
Caption = "..."
BeginProperty Font
Name = "宋体"
Size = 6.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 3840
Style = 1 'Graphical
TabIndex = 2
Top = 360
Width = 350
End
Begin VB.TextBox txtFileName
Height = 300
Left = 1320
Locked = -1 'True
TabIndex = 1
Top = 360
Width = 2415
End
Begin MSComctlLib.StatusBar StatusBar1
Height = 300
Index = 1
Left = 720
TabIndex = 4
Top = 817
Width = 1335
_ExtentX = 2355
_ExtentY = 529
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Bevel = 2
Object.Width = 4586
MinWidth = 4586
Text = "覆盖已有文件"
TextSave = "覆盖已有文件"
EndProperty
EndProperty
End
Begin MSComctlLib.StatusBar StatusBar1
Height = 300
Index = 2
Left = 240
TabIndex = 5
Top = 360
Width = 975
_ExtentX = 1720
_ExtentY = 529
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Bevel = 2
Object.Width = 4586
MinWidth = 4586
Text = "文件名："
TextSave = "文件名："
EndProperty
EndProperty
End
End
End
Attribute VB_Name = "dlgDatabaseBackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'********************************************************************************
' 窗体 : dlgDatabaseBackup 数据库备份操作
' 生成 : Jack Xu 2001.11.5
' 代码编写 : Jack Xu 2001.11.5
' 说明 : 数据库操作的权限必须很高。
'********************************************************************************
Option Explicit
Dim m_tagErrInfo As TYPE_ERRORINFO ' 错误信息
Private Sub Form_Load()
On Error GoTo ERROR_EXIT
If Not DBCanExecBackup Then
Unload Me
Exit Sub
End If
optFull.Value = True
optDiff.Value = False
chkOverWrite.Value = 1
txtFileName.Text = ""
cmdOk.Enabled = False
Exit Sub
ERROR_EXIT:
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "dlgDatabaseBackup"
m_tagErrInfo.strErrFunc = "Form_Load"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
End Sub
'***************************************************
' 释放内存
Private Sub Form_Terminate()
On Error Resume Next
Set dlgDatabaseBackup = Nothing
End Sub
'*********************************
' 确定按钮
Private Sub cmdOK_Click()
On Error GoTo ERROR_EXIT
Dim nRet As Integer
'检查并设置文件名，包括完整路径
If Trim(txtFileName.Text) = "" Then GoTo ERROR_EXIT
If InStr(Trim(txtFileName.Text), ":") < 2 And InStr(Trim(txtFileName.Text), "\") < 1 Then
txtFileName.Text = GetSQLServerSysPath & "\BACKUP\" & txtFileName.Text
ElseIf InStr(Trim(txtFileName.Text), ":") < 2 Or InStr(Trim(txtFileName.Text), "\") < 1 Then
MsgBox "请正确输入备份文件名的完整路径！", vbOKOnly, "操作提示"
Exit Sub
End If
If chkOverWrite.Value = 0 Then
nRet = CheckFileNameExist ' 返回值 ： 0 表示没有重名 1 表示重名 其他表示出错（未知）
Select Case nRet
Case 0
Case 1
If vbYes <> MsgBox("发现同名备份文件，是否覆盖已有文件？", vbYesNo, "操作提示") Then Exit Sub
Case Else
GoTo ERROR_EXIT
End Select
End If
modDatabase.BackupDataBase txtFileName.Text, optFull.Value
Unload Me
Exit Sub
ERROR_EXIT:
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "dlgDatabaseBackup"
m_tagErrInfo.strErrFunc = "cmdOk_Click"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
Unload Me
End Sub
'*********************************
' 选择备份文件名
Private Sub cmdOpenFile_Click()
On Error Resume Next
'dlgDatabaseBKOpen.Show vbModal
End Sub
'*********************************
' 放弃
Private Sub cmdQuit_Click()
Unload Me
End Sub
Private Sub txtFileName_Change()
On Error Resume Next
If Trim(txtFileName.Text) <> "" Then
cmdOk.Enabled = True
Else
cmdOk.Enabled = False
End If
End Sub
'*********************************
' 检查新备份文件名是否和已有文件重名
' 返回值 ： 0 表示没有重名 1 表示重名 其他表示出错（未知）
Private Function CheckFileNameExist() As Integer
On Error GoTo ERROR_EXIT
Dim rs As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim i As Long
'查询数据库主表
cmd.ActiveConnection = dbMyDB
cmd.CommandText = " SELECT bc_filename FROM T_DATABASE_BACKUP WHERE bc_flag = 0 bc_SrcdbName = '" _
& g_MyUserDB.strUserDatabase & "'"
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenStatic, adLockReadOnly
If rs.State <> adStateOpen Then GoTo ERROR_EXIT
If Not rs.EOF And rs.RecordCount > 0 Then
rs.MoveFirst
For i = 0 To rs.RecordCount - 1
If Trim(rs!bc_filename) = Trim(txtFileName.Text) Then
CheckFileNameExist = 1
GoTo ERROR_EXIST
End If
rs.MoveNext
Next
End If
CheckFileNameExist = 0
ERROR_EXIST:
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
Set cmd = Nothing
Exit Function
ERROR_EXIT:
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "dlgDatabaseBackup"
m_tagErrInfo.strErrFunc = "CheckFileNameExist"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
Set cmd = Nothing
CheckFileNameExist = 2
End Function
'*********************************
' 设置备份文件名，由 dlgDatabaseBKOpen 窗体调用
Public Sub SetFileName(ByVal strFileName As String)
On Error Resume Next
txtFileName.Text = strFileName
If UCase(Right(txtFileName.Text, 4)) <> ".BAK" Then txtFileName.Text = txtFileName.Text & ".BAK"
End Sub
Private Sub txtFileName_GotFocus()
txtFileName.BackColor = &H80000018
End Sub
Private Sub txtFileName_LostFocus()
txtFileName.BackColor = &H80000005
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -