www.pudn.com > 进行数据库备份与恢复有VB6.0开发完整源码.zip > DataBackup.ctl
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.UserControl DataBackup
ClientHeight = 3315
ClientLeft = 0
ClientTop = 0
ClientWidth = 6015
LockControls = -1 'True
ScaleHeight = 3315
ScaleWidth = 6015
ToolboxBitmap = "DataBackup.ctx":0000
Begin MSComDlg.CommonDialog dlgBrowser
Left = 105
Top = 225
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame Frame1
ForeColor = &H00FF0000&
Height = 3360
Left = 0
TabIndex = 8
Top = -60
Width = 5985
Begin VB.CommandButton cmdRestore
Caption = "开始恢复"
Height = 960
Left = 4770
Picture = "DataBackup.ctx":0312
Style = 1 'Graphical
TabIndex = 14
Top = 2145
Width = 990
End
Begin VB.CommandButton cmdBackup
Caption = "开始备份"
Height = 960
Left = 4755
Picture = "DataBackup.ctx":0BDC
Style = 1 'Graphical
TabIndex = 13
Top = 645
Width = 990
End
Begin VB.CommandButton cmdSelect4
Caption = ".."
Height = 240
Left = 4380
TabIndex = 7
Top = 2835
Width = 315
End
Begin VB.CommandButton cmdSelect2
Caption = ".."
Height = 240
Left = 4380
TabIndex = 5
Top = 1335
Width = 315
End
Begin VB.TextBox txtBackupFileTo
Height = 285
Left = 285
TabIndex = 1
Top = 1305
Width = 4425
End
Begin VB.CommandButton cmdSelect3
Caption = ".."
Height = 240
Left = 4380
TabIndex = 6
Top = 2205
Width = 315
End
Begin VB.TextBox txtRestoreFileFrom
Height = 285
Left = 285
TabIndex = 2
Top = 2175
Width = 4425
End
Begin VB.CommandButton cmdSelect1
Caption = ".."
Height = 240
Left = 4380
TabIndex = 4
Top = 675
Width = 315
End
Begin VB.TextBox txtBackupFileFrom
Height = 285
Left = 285
TabIndex = 0
Top = 645
Width = 4425
End
Begin VB.TextBox txtRestoreFileTo
Height = 285
Left = 285
TabIndex = 3
Top = 2805
Width = 4425
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "请选择需要《恢复》到的目录："
ForeColor = &H000040C0&
Height = 180
Index = 1
Left = 285
TabIndex = 12
Top = 2580
Width = 2520
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "请选择需要《备份》到的目录："
ForeColor = &H000040C0&
Height = 180
Index = 1
Left = 270
TabIndex = 11
Top = 1065
Width = 2520
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
Index = 1
X1 = 255
X2 = 5745
Y1 = 1740
Y2 = 1740
End
Begin VB.Line Line1
Index = 0
X1 = 270
X2 = 5730
Y1 = 1725
Y2 = 1725
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "请选择需要《恢复》的文件："
ForeColor = &H00008000&
Height = 180
Index = 0
Left = 285
TabIndex = 10
Top = 1920
Width = 2340
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "请选择需要《备份》的文件："
ForeColor = &H00800000&
Height = 180
Index = 0
Left = 255
TabIndex = 9
Top = 405
Width = 2340
End
End
End
Attribute VB_Name = "DataBackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private Sub cmdBackup_Click()
'检测备份路径与其它是否为空
If Trim(txtBackupFileFrom.Text) = "" Then
MsgBox "对不起，请输入要备份的文件后，才能备份！ ", vbInformation
txtBackupFileFrom.SetFocus
Exit Sub
End If
If Dir(Trim(txtBackupFileFrom.Text), vbNormal) = "" Then
MsgBox "Sorry，输入备份的文件不存在或不能访问？ ", vbInformation
txtBackupFileFrom.SetFocus
Exit Sub
End If
If Trim(txtBackupFileTo.Text) = "" Then
MsgBox "对不起，请输入备份路径，才能备份！ ", vbInformation
txtBackupFileTo.SetFocus
Exit Sub
End If
If Dir(Trim(txtBackupFileTo.Text), vbDirectory) = "" Then
MsgBox "Sorry，输入备份的路径不存在或不能访问？ ", vbInformation
txtBackupFileTo.SetFocus
Exit Sub
End If
StartIt "Backup"
End Sub
Private Sub cmdRestore_Click()
'检测备份路径与其它是否为空
If Trim(txtRestoreFileFrom.Text) = "" Then
MsgBox "对不起，请输入要恢复的文件后，才能备份！ ", vbInformation
txtRestoreFileFrom.SetFocus
Exit Sub
End If
If Dir(Trim(txtRestoreFileFrom.Text), vbNormal) = "" Then
MsgBox "Sorry，输入恢复的文件不存在或不能访问？ ", vbInformation
txtRestoreFileFrom.SetFocus
Exit Sub
End If
If Trim(txtRestoreFileTo.Text) = "" Then
MsgBox "对不起，请输入要恢复路径，才能恢复！ ", vbInformation
txtRestoreFileTo.SetFocus
Exit Sub
End If
If Dir(Trim(txtRestoreFileTo.Text), vbDirectory) = "" Then
MsgBox "Sorry，输入恢复的路径不存在或不能访问？ ", vbInformation
txtRestoreFileTo.SetFocus
Exit Sub
End If
StartIt "Restore"
End Sub
Private Sub cmdSelect1_Click()
On Error Resume Next
dlgBrowser.DialogTitle = "请选择需要备份的文件"
dlgBrowser.CancelError = True
dlgBrowser.Filter = "所有文件(*.*)|*.*|Access文件(*.MDB)|*.MDB|VB中国备份文件(*.YVB)|*.YVB"
dlgBrowser.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly + cdlOFNPathMustExist
dlgBrowser.ShowOpen
txtBackupFileFrom = dlgBrowser.FileName
txtBackupFileFrom.SetFocus
If Err.Number = 32755 Then '取消时
Exit Sub
End If
End Sub
Private Sub cmdSelect2_Click()
Dim BI As BROWSEINFO
Dim nFolder As Long
Dim IDL As ITEMIDLIST
Dim pIdl As Long
Dim sPath As String
Dim SHFI As SHFILEINFO
With BI
.hOwner = UserControl.hwnd
nFolder = GetFolderValue(m_wCurOptIdx)
If SHGetSpecialFolderLocation(ByVal UserControl.hwnd, ByVal nFolder, IDL) = NOERROR Then
.pidlRoot = IDL.mkid.cb
End If
.pszDisplayName = String$(MAX_PATH, 0)
.lpszTitle = "请选择备份的路径 => 程序:俞思龙"
.ulFlags = GetReturnType()
End With
' 显示浏览对话框
pIdl = SHBrowseForFolder(BI)
If pIdl = 0 Then Exit Sub
sPath = String$(MAX_PATH, 0)
SHGetPathFromIDList ByVal pIdl, ByVal sPath
txtBackupFileTo.Text = Left(sPath, InStr(sPath, vbNullChar) - 1)
txtBackupFileTo.SetFocus
End Sub
Private Sub cmdSelect3_Click()
On Error Resume Next
dlgBrowser.DialogTitle = "请选择需要恢复的文件"
dlgBrowser.CancelError = True
dlgBrowser.Filter = "所有文件(*.*)|*.*|Access文件(*.MDB)|*.MDB|VB中国恢复文件(*.YVB)|*.YVB"
dlgBrowser.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly + cdlOFNPathMustExist
dlgBrowser.ShowOpen
txtRestoreFileFrom = dlgBrowser.FileName
txtRestoreFileFrom.SetFocus
If Err.Number = 32755 Then '取消时
Exit Sub
End If
End Sub
Private Sub cmdSelect4_Click()
Dim BI As BROWSEINFO
Dim nFolder As Long
Dim IDL As ITEMIDLIST
Dim pIdl As Long
Dim sPath As String
Dim SHFI As SHFILEINFO
With BI
.hOwner = UserControl.hwnd
nFolder = GetFolderValue(m_wCurOptIdx)
If SHGetSpecialFolderLocation(ByVal UserControl.hwnd, ByVal nFolder, IDL) = NOERROR Then
.pidlRoot = IDL.mkid.cb
End If
.pszDisplayName = String$(MAX_PATH, 0)
.lpszTitle = "请选择恢复的路径 => 程序:俞思龙"
.ulFlags = GetReturnType()
End With
' 显示浏览对话框
pIdl = SHBrowseForFolder(BI)
If pIdl = 0 Then Exit Sub
sPath = String$(MAX_PATH, 0)
SHGetPathFromIDList ByVal pIdl, ByVal sPath
txtRestoreFileTo.Text = Left(sPath, InStr(sPath, vbNullChar) - 1)
txtRestoreFileTo.SetFocus
End Sub
Private Sub txtBackupFileFrom_Click()
BackUpFileFrom = txtBackupFileFrom
End Sub
Private Sub txtBackupFileFrom_GotFocus()
txtBackupFileFrom.SelStart = 0
txtBackupFileFrom.SelLength = Len(txtBackupFileFrom)
End Sub
Private Sub txtBackupFileTo_Change()
BackUpFileTo = txtBackupFileTo
End Sub
Private Sub txtBackupFileTo_GotFocus()
txtBackupFileTo.SelStart = 0
txtBackupFileTo.SelLength = Len(txtBackupFileTo)
End Sub
Private Sub txtRestoreFileFrom_Change()
RestoreFileFrom = txtRestoreFileFrom
End Sub
Private Sub txtRestoreFileFrom_GotFocus()
txtRestoreFileFrom.SelStart = 0
txtRestoreFileFrom.SelLength = Len(txtRestoreFileFrom)
End Sub
Private Sub txtRestoreFileTo_Change()
RestoreFileTo = txtRestoreFileTo
End Sub
Private Sub txtRestoreFileTo_GotFocus()
txtRestoreFileFrom.SelStart = 0
txtRestoreFileFrom.SelLength = Len(txtRestoreFileFrom)
End Sub
'注意！不要删除或修改下列被注释的行！
'MappingInfo=txtBackupFileFrom,txtBackupFileFrom,-1,Text
Public Property Get BackUpFileFrom() As String
Attribute BackUpFileFrom.VB_Description = "返回/设置控件中包含的文本。"
BackUpFileFrom = txtBackupFileFrom.Text
End Property
Public Property Let BackUpFileFrom(ByVal New_BackUpFileFrom As String)
txtBackupFileFrom.Text() = New_BackUpFileFrom
PropertyChanged "BackUpFileFrom"
End Property
'注意！不要删除或修改下列被注释的行！
'MappingInfo=txtBackupFileTo,txtBackupFileTo,-1,Text
Public Property Get BackUpFileTo() As String
Attribute BackUpFileTo.VB_Description = "返回/设置控件中包含的文本。"
BackUpFileTo = txtBackupFileTo.Text
End Property
Public Property Let BackUpFileTo(ByVal New_BackUpFileTo As String)
txtBackupFileTo.Text() = New_BackUpFileTo
PropertyChanged "BackUpFileTo"
End Property
'注意！不要删除或修改下列被注释的行！
'MappingInfo=txtRestoreFileFrom,txtRestoreFileFrom,-1,Text
Public Property Get RestoreFileFrom() As String
Attribute RestoreFileFrom.VB_Description = "返回/设置控件中包含的文本。"
RestoreFileFrom = txtRestoreFileFrom.Text
End Property
Public Property Let RestoreFileFrom(ByVal New_RestoreFileFrom As String)
txtRestoreFileFrom.Text() = New_RestoreFileFrom
PropertyChanged "RestoreFileFrom"
End Property
'注意！不要删除或修改下列被注释的行！
'MappingInfo=txtRestoreFileTo,txtRestoreFileTo,-1,Text
Public Property Get RestoreFileTo() As String
Attribute RestoreFileTo.VB_Description = "返回/设置控件中包含的文本。"
RestoreFileTo = txtRestoreFileTo.Text
End Property
Public Property Let RestoreFileTo(ByVal New_RestoreFileTo As String)
txtRestoreFileTo.Text() = New_RestoreFileTo
PropertyChanged "RestoreFileTo"
End Property
'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
txtBackupFileFrom.Text = PropBag.ReadProperty("BackUpFileFrom", "")
txtBackupFileTo.Text = PropBag.ReadProperty("BackUpFileTo", "")
txtRestoreFileFrom.Text = PropBag.ReadProperty("RestoreFileFrom", "")
txtRestoreFileTo.Text = PropBag.ReadProperty("RestoreFileTo", "")
End Sub
Private Sub UserControl_Resize()
Size Frame1.Width, Frame1.Height
End Sub
'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("BackUpFileFrom", txtBackupFileFrom.Text, "")
Call PropBag.WriteProperty("BackUpFileTo", txtBackupFileTo.Text, "")
Call PropBag.WriteProperty("RestoreFileFrom", txtRestoreFileFrom.Text, "")
Call PropBag.WriteProperty("RestoreFileTo", txtRestoreFileTo.Text, "")
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 StartIt(sType)
On Error GoTo POP_ERR
Dim SHop As SHFILEOPSTRUCT
If sType = "Backup" Then '备份时
With SHop
.fFlags = FOF_SIMPLEPROGRESS
.pFrom = BackUpFileFrom
.pTo = BackUpFileTo
.wFunc = FO_COPY '复制
End With
Else '恢复
With SHop
.fFlags = FOF_SIMPLEPROGRESS
.pFrom = RestoreFileFrom
.pTo = RestoreFileTo
.wFunc = FO_COPY '复制
End With
End If
SHFileOperation SHop
MsgBox "备份与恢复处理完毕！ ", vbInformation
Exit Sub
POP_ERR:
MsgBox "没有正常处理备份与恢复！ ", vbExclamation
Exit Sub
End Sub