?? 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 + -