📄 netdata.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form BackUpData
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "银行存取款数据库备份"
ClientHeight = 1440
ClientLeft = 45
ClientTop = 330
ClientWidth = 6375
Icon = "NetData.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1440
ScaleWidth = 6375
Begin VB.PictureBox Picture1
Height = 1095
Left = 120
ScaleHeight = 1035
ScaleWidth = 4635
TabIndex = 2
Top = 120
Width = 4695
Begin VB.PictureBox cmdBrowse
AutoSize = -1 'True
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 240
Left = 4245
Picture = "NetData.frx":030A
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 8
ToolTipText = "请选择网络路径"
Top = 630
Width = 240
End
Begin VB.TextBox BakName
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 315
Left = 1200
TabIndex = 7
Top = 120
Width = 2295
End
Begin VB.CheckBox ChkCompact
Caption = "压缩数据"
Height = 255
Left = 3600
TabIndex = 4
Top = 120
Width = 1095
End
Begin VB.TextBox BakPath
BackColor = &H00FFFFFF&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 315
Left = 1200
MaxLength = 250
TabIndex = 3
Top = 600
Width = 2865
End
Begin VB.Line lLeft
BorderColor = &H00808080&
Visible = 0 'False
X1 = 4200
X2 = 4200
Y1 = 600
Y2 = 930
End
Begin VB.Line lTop
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 4200
X2 = 4515
Y1 = 600
Y2 = 600
End
Begin VB.Line lRight
BorderColor = &H00FFFFFF&
Visible = 0 'False
X1 = 4515
X2 = 4515
Y1 = 600
Y2 = 915
End
Begin VB.Line lBottom
BorderColor = &H00808080&
Visible = 0 'False
X1 = 4215
X2 = 4515
Y1 = 915
Y2 = 915
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "备份路径："
ForeColor = &H00000000&
Height = 180
Left = 300
TabIndex = 6
Top = 650
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "备份名："
Height = 180
Left = 480
TabIndex = 5
Top = 165
Width = 720
End
Begin VB.Image Image1
Height = 480
Left = 0
Picture = "NetData.frx":0454
Top = 0
Width = 480
End
End
Begin VB.CommandButton NetCancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 405
Left = 4920
TabIndex = 1
Top = 720
Width = 1320
End
Begin VB.CommandButton OK
Caption = "备份(&B)"
Default = -1 'True
Enabled = 0 'False
Height = 405
Left = 4920
TabIndex = 0
Top = 240
Width = 1320
End
Begin MSComDlg.CommonDialog dlgCommonDialog
Left = 1680
Top = 960
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Line Line5
BorderColor = &H00808080&
Visible = 0 'False
X1 = 0
X2 = 0
Y1 = 0
Y2 = 330
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 4
X1 = 0
X2 = 6345
Y1 = 0
Y2 = 0
End
Begin VB.Line Line1
BorderColor = &H00E0E0E0&
Index = 1
X1 = 30
X2 = 6330
Y1 = 15
Y2 = 15
End
Begin VB.Line Line1
BorderColor = &H00E0E0E0&
Index = 2
X1 = 15
X2 = 6330
Y1 = 1410
Y2 = 1410
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 3
X1 = 30
X2 = 6330
Y1 = 1395
Y2 = 1395
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 2
X1 = 0
X2 = 0
Y1 = 0
Y2 = 1410
End
Begin VB.Line Line2
BorderColor = &H00808080&
Index = 1
X1 = 6330
X2 = 6330
Y1 = 0
Y2 = 1410
End
Begin VB.Line Line3
BorderColor = &H00E0E0E0&
Index = 1
X1 = 6345
X2 = 6345
Y1 = 0
Y2 = 1410
End
End
Attribute VB_Name = "BackupData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const m_wCurOptIdx = 0
Dim lShow As Boolean
Private Sub cmdBrowse_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
lTop.BorderColor = &H808080
lBottom.BorderColor = &HFFFFFF
End Sub
Private Sub cmdBrowse_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If lShow = True Then Exit Sub '已经隐藏时退出
lLeft.Visible = True
lRight.Visible = True
lTop.Visible = True
lBottom.Visible = True
lShow = True
End Sub
Private Sub cmdBrowse_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
lTop.BorderColor = &HFFFFFF
lBottom.BorderColor = &H808080
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2, Me.Width, Me.Height
AniShowFrm Me.hwnd
Dim wIdx As Integer, nFolder As Long
Dim sPath As String * MAX_PATH
Dim IDL As ITEMIDLIST
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If lShow = False Then Exit Sub '已经隐藏时退出
lLeft.Visible = False
lRight.Visible = False
lTop.Visible = False
lBottom.Visible = False
lShow = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
AniUnloadFrm Me.hwnd
End Sub
Private Sub NetCancel_Click()
Unload Me
End Sub
Private Sub bakpath_Change()
If Trim(BakPath.Text) = "" Then
OK.Enabled = False
Else
OK.Enabled = True
End If
End Sub
Private Sub BakPath_GotFocus()
BakPath.SelStart = 0
BakPath.SelLength = Len(Trim(BakPath.Text))
End Sub
Private Sub BakPath_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub BakPath_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If lShow = False Then Exit Sub '已经隐藏时退出
lLeft.Visible = False
lRight.Visible = False
lTop.Visible = False
lBottom.Visible = False
lShow = False
End Sub
Private Sub OK_Click()
Dim db As Database
Dim rs As Recordset
Dim OriginalPath, TargetPath As String
Dim SqlStr As String
OriginalPath = App.Path & "\bank.mdb"
TargetPath = BakPath.Text
If Dir(OriginalPath) = "" Then
MsgBox "银行数据库没找到，文件" & OriginalPath, vbCritical, "提示："
Exit Sub
End If
If Dir(TargetPath) <> "" Then
SetAttr TargetPath, vbNormal
Kill TargetPath
End If
On Error GoTo Err:
Set db = OpenDatabase(ConData, False, False, ConStr)
Set rs = db.OpenRecordset("备份记录", dbOpenDynaset)
If BakName = "" Then BakName = Date
SqlStr = "名称='" & BakName & "'"
rs.FindFirst SqlStr
If Not rs.NoMatch Then
MsgBox "备份名在备份集中有重名，请改更备份名!", vbExclamation, "提示："
BakName.SetFocus
db.Close
Exit Sub
End If
If ChkCompact.Value = 1 Then
'如果选择压缩数据就使用压缩备份
DBEngine.CompactDatabase OriginalPath, TargetPath
Else
'未选择压缩就直接复制备份
FileCopy OriginalPath, TargetPath
End If
With rs
.AddNew
If BakName <> "" Then
!名称 = BakName
Else
!名称 = Date
End If
!时间 = Date
!路径 = BakPath
.Update
db.Close
End With
MsgBox "数据库已备份成功!", vbInformation, "提示："
Unload Me
Exit Sub
Err:
MsgBox Err.Description, vbCritical, "提示："
End Sub
Private Function GetFolderValue(wIdx As Integer) As Long
If wIdx < 2 Then
GetFolderValue = 0
ElseIf wIdx < 12 Then
GetFolderValue = wIdx
Else
GetFolderValue = wIdx + 4
End If
End Function
Private Function GetReturnType() As Long
Dim dwRtn As Long
dwRtn = dwRtn
GetReturnType = dwRtn
End Function
Private Sub cmdBrowse_Click()
lTop.BorderColor = &H808080
lBottom.BorderColor = &HFFFFFF
Dim sFile As String
With dlgCommonDialog
.DialogTitle = "请选择备份路径与备份文件名"
.CancelError = False
'ToDo: 设置 common dialog 控件的标志和属性
.Filter = "数据库文件 (*.MDB)|*.MDB"
.ShowOpen
If Len(.FileName) = 0 Then
Exit Sub
End If
sFile = .FileName
BakPath = .FileName
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -