📄 frmpath.frm
字号:
VERSION 5.00
Begin VB.Form frmPath
BorderStyle = 3 'Fixed Dialog
ClientHeight = 2055
ClientLeft = 45
ClientTop = 330
ClientWidth = 5355
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmPath.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2055
ScaleWidth = 5355
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton cmdPath
Caption = "…"
Height = 320
Left = 4800
TabIndex = 5
Top = 1200
Width = 495
End
Begin Manage.xpcmdButton cmdClose
Height = 375
Left = 4200
TabIndex = 4
Top = 1620
Width = 1095
_ExtentX = 1931
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "关闭(&C)"
ForeColor = -2147483630
ForeHover = 0
End
Begin Manage.xpcmdButton cmdOK
Height = 375
Left = 3000
TabIndex = 1
Top = 1620
Width = 1095
_ExtentX = 1931
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "确定(&O)"
ForeColor = -2147483630
ForeHover = 0
End
Begin VB.TextBox txtPath
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 320
Left = 720
TabIndex = 0
Top = 1215
Width = 4035
End
Begin VB.Label lblPath
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "路径:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 180
Index = 0
Left = 120
TabIndex = 3
Top = 1260
Width = 495
End
Begin VB.Label lblName
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 2040
TabIndex = 2
Top = 360
Width = 135
End
Begin VB.Image imgLog
Height = 615
Left = 120
Top = 120
Width = 615
End
Begin VB.Image imgPath
Height = 735
Left = 60
Stretch = -1 'True
Top = 60
Width = 5235
End
End
Attribute VB_Name = "frmPath"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''===========================================================================
''备份与恢复功能
''备份存储方式，完全备份方式（复制数据库文件至存放的目录下）
''备份成功后将备份信息写入数据库中，作为备份日志进行保留，写入信息为文件名，存放路径，存放时间和备注
''恢复数据方式，完全恢复方式，
''
''
''===========================================================================
''ALTER DATABASE Northwind SET SINGLE_USER WITH ROLLBACK AFTER 30 SECONDS '等30秒后关闭所有用户,并改为单用户模式
''ALTER DATABASE Northwind SET RECOVERY FULL '设存为备份完全恢复模式 '人力资源
''ALTER DATABASE 人力资源 SET RESTRICTED_USER '恢复用户模式为多用户模式
'' If gblnBR = False Then
'' On Error GoTo errNext1
'' adoConn.Execute "backup database " & gstrDatabaseName & " to disk='" & Trim(txtPath.Text) & "'"
'' MsgBox "数据库备份成功!", vbInformation, "系统提示"
'' Exit Sub
''errNext1:
'' Call ErrMsg("备份数据库失败：" & vbCrLf & Err.Number, Err.Description)
'' Else
'' On Error GoTo errNext2
'' adoConn.Execute "restore database " & gstrDatabaseName & " from disk='" & Trim(txtPath.Text) & "'"
'' MsgBox "数据库恢复成功!", vbInformation, "系统提示"
'' Exit Sub
''errNext2:
'' Call ErrMsg("恢复数据库失败：" & vbCrLf & Err.Number, Err.Description & vbCrLf & "请关闭其它用户对此数据库的操作,再次进行恢复功能." & vbCrLf & "如果依然存在问题，请网络管理员在服务器本地对数据库进行恢复操作.")
'' End If
'Option Explicit
'Dim adoTempLink As New ADODB.Recordset
'Dim strPath As String
'Dim strBR As String
'Dim objFile As Object
'Private Sub cmdClose_Click()
' Unload Me
'End Sub
'
'Private Sub cmdOK_Click()
' Dim blnFlag As Boolean
' On Error GoTo errNext
' Set objFile = CreateObject("scripting.filesystemobject")
' With MDIMain.cdgMain
' If gblnBR = True Then
' .DialogTitle = "数据库备份为..."
' .Filename = ""
' .Filter = "Access数据库(*.mdb)|*.mdb|"
' .ShowSave
' If Len(.Filename) = 0 Then Exit Sub
' blnFlag = objFile.fileExists(.Filename)
' If blnFlag = True Then
' If MsgBox("发现备份文件已存在,是否覆盖?", vbInformation + vbOKCancel, App.Title) = vbCancel Then
' MsgBox "备份操作未完成!", vbExclamation, App.Title
' Exit Sub
' End If
' End If
' objFile.CopyFile gstrDatabaseName, .Filename
' Else
' If MsgBox("恢复数据库操作将覆盖当前使用的数据库,确认要恢复吗?", vbInformation + vbYesNo, App.Title) = vbYes Then
' .DialogTitle = "数据库恢复为..."
' .Filename = ""
' .Filter = "Access数据库(*.mdb)|*.mdb|"
' .ShowOpen
' If Len(.Filename) = 0 Then Exit Sub
' If .Filename = gstrDatabaseName Then
' MsgBox "选中的数据库就是当前操作的数据库," & vbTab & vbCrLf & vbCrLf & "恢复操作失败,请重新选择数据库!", vbExclamation, App.Title
' Exit Sub
' End If
' If adoConn.State = adStateOpen Then adoConn.Close
' Set adoConn = Nothing
' objFile.CopyFile .Filename, gstrDatabaseName
' adoConn.CursorLocation = adUseClient
' adoConn.Open gstrNowLink
' Else
' MsgBox "恢复操作未完成!", vbExclamation, App.Title
' Exit Sub
' End If
' End If
' End With
' MsgBox "数据库" & strBR & "成功!", vbInformation, "系统提示"
' Exit Sub
'errNext:
' Call ErrMsg(strBR & "数据库失败：" & vbCrLf & Err.Number, Err.Description)
'End Sub
'
'Private Sub cmdPath_Click()
' With MDIMain.cdgMain
' If gblnBR = True Then
' .DialogTitle = "数据库备份为..."
' .Filename = ""
' .Filter = "Access数据库(*.mdb)|*.mdb|"
' .ShowSave
' Else
' If MsgBox("恢复数据库操作将覆盖当前使用的数据库,确认要恢复吗?", vbInformation + vbYesNo, App.Title) = vbYes Then
' .DialogTitle = "数据库恢复为..."
' .Filename = ""
' .Filter = "Access数据库(*.mdb)|*.mdb|"
' .ShowOpen
' End If
' End If
' If Len(.Filename) > 0 Then strPath = .Filename
' txtPath.Text = strPath
' End With
'End Sub
'
'Private Sub Form_Load()
' On Error Resume Next
' imgLog.Picture = MDIMain.iltPic56.ListImages(1).Picture
' Dim strPicPath As String
' If gblnBR = False Then
' strBR = "恢复"
' strPicPath = App.Path & "\pic\line2.gif"
' Else
' strBR = "备份"
' strPicPath = App.Path & "\pic\line1.gif"
' End If
' Me.Caption = "数据库" & strBR
' lblName.Caption = "数据库" & strBR
' imgPath.Picture = LoadPicture(strPicPath)
'End Sub
'
'Private Sub Form_Unload(Cancel As Integer)
' MDIMain.Enabled = True
' Set adoTempLink = Nothing
' Set objFile = Nothing
'End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -