📄 frmbup.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MsComCtl.ocx"
Begin VB.Form FrmBackUp
BorderStyle = 1 'Fixed Single
Caption = "数据库维护"
ClientHeight = 5355
ClientLeft = 45
ClientTop = 330
ClientWidth = 6435
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
ScaleHeight = 5355
ScaleWidth = 6435
Begin VB.CommandButton Command2
Caption = "退出"
Height = 495
Left = 3480
TabIndex = 13
Top = 4680
Width = 975
End
Begin VB.CommandButton Command1
Caption = "数据备分或数据恢复"
Height = 495
Left = 1080
TabIndex = 12
Top = 4680
Width = 2175
End
Begin VB.OptionButton Option2
Height = 255
Left = 4560
TabIndex = 5
Top = 240
Width = 375
End
Begin VB.OptionButton Option1
Height = 255
Left = 2880
TabIndex = 3
Top = 240
Value = -1 'True
Width = 495
End
Begin VB.Frame Frame2
Caption = "请选择数据库文件"
Height = 3015
Left = 3000
TabIndex = 1
Top = 840
Width = 3015
Begin VB.FileListBox File1
Height = 1530
Left = 120
Pattern = "*.mdb"
TabIndex = 10
Top = 1440
Width = 2775
End
Begin VB.DirListBox Dir1
Height = 720
Left = 120
TabIndex = 9
Top = 600
Width = 2775
End
Begin VB.DriveListBox Drive1
Height = 300
Left = 120
TabIndex = 8
Top = 240
Width = 2775
End
End
Begin VB.Frame Frame1
Caption = "备分卡列表"
Height = 3015
Left = 120
TabIndex = 0
Top = 840
Width = 2775
Begin MSComctlLib.ImageList ImageList1
Left = -135
Top = 1200
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 1
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmBUp.frx":0000
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.ListView ListView1
Height = 2775
Left = 120
TabIndex = 2
Top = 240
Width = 2535
_ExtentX = 4471
_ExtentY = 4895
Sorted = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
AllowReorder = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
End
Begin VB.Label Label1
Caption = "Label4"
Height = 615
Left = 120
TabIndex = 11
Top = 3960
Width = 5895
End
Begin VB.Label Label3
Caption = "请选择数据备分或数据恢复选项"
ForeColor = &H00004040&
Height = 615
Left = 0
TabIndex = 7
Top = 240
Width = 2535
End
Begin VB.Label Label2
Caption = "数据恢复"
Height = 375
Left = 5040
TabIndex = 6
Top = 240
Width = 855
End
Begin VB.Label Label4
Caption = "数据备分"
Height = 375
Left = 3360
TabIndex = 4
Top = 240
Width = 855
End
End
Attribute VB_Name = "FrmBackUp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const REG_SZ = 1
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Dim itmX, key As String '定义字符串变量
Dim a As Integer '定义整型变量
Private Sub Form_Load()
On Error Resume Next
MkDir App.Path & "\Backup"
Option1.Value = True
Dir1_Change
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
'添加数据备份卡到列表中
ListView1.ListItems.Clear
If File1.ListCount <> 0 Then
a = 0
Do While File1.ListIndex < File1.ListCount - 1
File1.ListIndex = a
key = File1.FileName
Set itmX = ListView1.ListItems.Add(, , key, 1)
a = a + 1
Loop
End If
Label1.Caption = Dir1.Path & "\" & File1.FileName
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_Click()
Label1.Caption = Dir1.Path & "\" & File1.FileName '获取路径
End Sub
Private Sub Command1_Click()
Dim strstring As String
Dim m As Date
On Error Resume Next
If Option1.Value = True Then
'备份数据库
If File1.ListCount <> 0 Then
Kill App.Path & "\backup\*.mdb"
FileCopy Trim(Label1.Caption), App.Path & "\backup\" & Date & "备份卡" & File1.FileName
Me.MousePointer = 0
MsgBox "数据已备份完毕！"
key = Date & "备份卡" & File1.FileName
Set itmX = ListView1.ListItems.Add(, , key, 1)
strstring = Date
SaveString HKEY_CURRENT_USER, "RegData", "Date", strstring
End If
End If
If Option2.Value = True Then
'恢复指定路径下的数据库
If File1.ListCount <> 0 Then
m = GetString(HKEY_CURRENT_USER, "RegData\Date", "")
FileCopy App.Path & "\backup\" & m & "备份卡" & "db2.mdb", File1.FileName
Me.MousePointer = 0
MsgBox "数据已恢复完毕！"
Else
MsgBox "请选择要恢复的数据！"
End If
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
Dim strstring As String
On Error Resume Next
Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
RegQueryValueEx hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize
strBuf = String(lDataBufSize, Chr$(0))
RegQueryValueEx hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
Exit Function
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
RegOpenKey hKey, strPath, Ret
GetString = RegQueryStringValue(Ret, strValue)
RegCloseKey Ret
End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
RegCreateKey hKey, strPath, Ret
RegSetValue Ret, strValue, REG_SZ, strData, Len(strData)
RegCloseKey Ret
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -