frmrestore.frm

利用VB+ACCESS开发的专用布料管理系统

End
Attribute VB_Name = "FrmRestore"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type BackUpStruct
    UseDate As String
    BackupDate As String
    BackupUser As String
    Demo As String
    BackupFile As String
End Type
Dim BpFile() As BackUpStruct

Dim MdbFileName As String
Public MdbPathName As String            '还原成的数据库文件：MDB(扩展名)
Public NamFileName As String            '要还原的压缩文件：NAM(扩展名)
Dim Fs As New Scripting.FileSystemObject

Dim i As Integer

Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0
            If UBound(BpFile, 1) = 0 Then Exit Sub
            On Error GoTo NumErr
            MdbPathName = Trim(Text1(0).Text)
            If Len(MdbPathName) = 0 Then
                MsgBox "没有选择要还原到的路径！", vbOKOnly + vbExclamation, "路径出错..."
                Exit Sub
            End If
            i = 1
            Do While i <> 0
                If Right(MdbPathName, 1) = "\" Then
                    MdbPathName = Left(MdbPathName, Len(MdbPathName) - 1)
                Else
                    i = 0
                End If
            Loop
            MdbPathName = MdbPathName & MdbFileName
        
            If NamFileName = "" Then
                MsgBox "没有备份数据可供还原！", vbOKOnly + vbExclamation, "还原出错..."
                Exit Sub
            End If
            If Fs.FileExists(NamFileName) = False Then
                MsgBox "当前路径没发现备份文件！", vbCritical + vbOKOnly, "文件出错..."
                Exit Sub
            End If
            If Fs.FileExists(MdbPathName) = True Then
                If MsgBox("指定路径下存在一个相同名称的数据库文件！" & vbCrLf & vbCrLf & _
                    "你真的要覆盖此文件吗？", vbCritical + vbOKCancel, "文件存在...") = vbOK Then
                    Fs.DeleteFile MdbPathName, True
                Else
                    Exit Sub
                End If
            End If
            MdlMain.FrmStatusType = "数据还原"
            FrmStatus.Label1.Caption = "正在还原数据..."
            FrmStatus.Show vbModal
            If MdlMain.FrmStatusType = "还原成功" Then
                MdlMain.FrmStatusType = ""
                MsgBox "系统数据还原成功！", vbOKOnly + vbInformation, "恭喜恭喜..."
                MdlMain.OpenType = "还原成功"
                Unload Me
            ElseIf MdlMain.FrmStatusType = "路径出错" Then
                MdlMain.FrmStatusType = ""
                MsgBox "路径/文件访问出错！", vbOKOnly + vbQuestion, "还原数据"
            ElseIf MdlMain.FrmStatusType = "未知错误" Then
                MdlMain.FrmStatusType = ""
                MsgBox "数据还原过程中出现未知错误，请关闭窗口后重试一次。" & vbCrLf & vbCrLf & _
                    "如果继续出现错误，请与本系统开发人员联系...", vbOKOnly + vbCritical, "还原数据"
            End If
            Exit Sub
NumErr:
            If Err.Number = 70 Then
                MsgBox "系统数据库访问出错，请确认是否正在使用数据库！！" & vbCrLf & vbCrLf & _
                    "如果正在使用数据库请关闭后再试一次。" & vbCrLf & vbCrLf & _
                    "如果还是不行请联系系统开发人员。", vbOKOnly + _
                    vbExclamation, "数据库正在使用？？"
            Else
                MsgBox Err.Number & "：" & Err.Description, vbOKOnly + vbQuestion, "系统出错！"
            End If
        Case 1
            Unload Me
        Case 2
            MsgBox "不好意思哦！本窗口暂未提供帮助！！", vbOKOnly + vbInformation, "很抱歉..."
        Case 3
            If UBound(BpFile, 1) = 0 Then Exit Sub
            If MsgBox("你真的要删除选定的备份文件吗？", vbOKCancel + vbQuestion, "确认删除...") = vbOK Then
                On Error GoTo NumErr1
                If Fs.FileExists(NamFileName) = True Then
                    Fs.DeleteFile NamFileName, True
                End If
                Dim Cn As New ADODB.Connection
                Cn.Open DbLoginSql
                Cn.Execute "delete from lqbackup where backupfile='" & NamFileName & "'"
                Dim Rec As New ADODB.Recordset
                ReDim BpFile(0)
                Rec.CursorLocation = adUseClient
                Rec.Open "select * from lqbackup", Cn, adOpenDynamic, adLockOptimistic
                If Not Rec.EOF And Not Rec.BOF Then
                    Dim Uv As Integer
                    Do While Not Rec.EOF
                        ReDim Preserve BpFile(UBound(BpFile, 1) + 1)
                        Uv = UBound(BpFile, 1) - 1
                        BpFile(Uv).UseDate = Rec.Fields("usedate").Value
                        BpFile(Uv).BackupDate = Rec.Fields("backupdate").Value
                        BpFile(Uv).BackupFile = Rec.Fields("backupfile").Value
                        BpFile(Uv).BackupUser = Rec.Fields("backupuser").Value
                        BpFile(Uv).Demo = Rec.Fields("demo").Value
                        Rec.MoveNext
                    Loop
                End If
                Rec.Close: Set Rec = Nothing
                Cn.Close: Set Cn = Nothing
                ListView1.ListItems.Clear
                If UBound(BpFile, 1) = 0 Then
                    ListView1.ListItems.Add , , "没有备份数据...", 2, 2
                    Command1(0).Enabled = False
                    Command1(3).Enabled = False
                Else
                    For i = 0 To UBound(BpFile, 1) - 1
                        ListView1.ListItems.Add , "r" & i, BpFile(i).BackupFile, 2, 2
                    Next i
                End If
                ListView1.ListItems(1).Selected = True
                ListView1.Tag = ListView1.SelectedItem.Key
                Call ListView1_ItemClick(ListView1.SelectedItem)
            End If
            Exit Sub
NumErr1:
            If Err.Number = 70 Then
                MsgBox "系统数据库访问出错，请确认是否正在使用数据库！！" & vbCrLf & vbCrLf & _
                    "如果正在使用数据库请关闭后再试一次。" & vbCrLf & vbCrLf & _
                    "如果还是不行请联系系统开发人员。", vbOKOnly + _
                    vbExclamation, "数据库正在使用？？"
            Else
                MsgBox Err.Number & "：" & Err.Description, vbOKOnly + vbQuestion, "系统出错！"
            End If
    End Select
End Sub

Private Sub Command2_Click()
    Dim iNull As Integer, lpIDList As Long, lResult As Long
    Dim sPath As String, udtBI As BrowseInfo
    With udtBI
        .hWndOwner = Me.hWnd
        .lpszTitle = lstrcat("C:\", "")
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        SHGetPathFromIDList lpIDList, sPath
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
        Text1(0).Text = IIf(Right(sPath, 1) = "\", Left(sPath, Len(sPath) - 1), sPath)
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyEscape Then Unload Me
End Sub

Private Sub Form_Load()
    Me.KeyPreview = True
    Label1(0).Caption = ""
    Label1(1).Caption = ""
    Label1(2).Caption = ""
    Text1(1).Text = ""
    Text1(1).Enabled = False
    Text1(0).Text = SysDbPath
    MdbFileName = "\maindb.mdb"
    NamFileName = ""
    
    Dim Cn As New ADODB.Connection
    Dim Rec As New ADODB.Recordset
    ReDim BpFile(0)
    Cn.Open DbLoginSql
    Rec.CursorLocation = adUseClient
    Rec.Open "select * from lqbackup", Cn, adOpenDynamic, adLockOptimistic
    If Not Rec.EOF And Not Rec.BOF Then
        Dim Uv As Integer
        Do While Not Rec.EOF
            ReDim Preserve BpFile(UBound(BpFile, 1) + 1)
            Uv = UBound(BpFile, 1) - 1
            BpFile(Uv).UseDate = Rec.Fields("usedate").Value
            BpFile(Uv).BackupDate = Rec.Fields("backupdate").Value
            BpFile(Uv).BackupFile = Rec.Fields("backupfile").Value
            BpFile(Uv).BackupUser = Rec.Fields("backupuser").Value
            BpFile(Uv).Demo = Rec.Fields("demo").Value
            Rec.MoveNext
        Loop
    End If
    Rec.Close: Set Rec = Nothing
    Cn.Close: Set Cn = Nothing
    ListView1.ListItems.Clear: ListView1.ColumnHeaders.Clear
    ListView1.ColumnHeaders.Add , "h1", "备份文件", 3850
    If UBound(BpFile, 1) = 0 Then
        ListView1.ListItems.Add , , "没有备份数据...", 2, 2
        Command1(0).Enabled = False
        Command1(3).Enabled = False
    Else
        For i = 0 To UBound(BpFile, 1) - 1
            ListView1.ListItems.Add , "r" & i, BpFile(i).BackupFile, 2, 2
        Next i
    End If
    ListView1.ListItems(1).Selected = True
    ListView1.Tag = ListView1.SelectedItem.Key
    Call ListView1_ItemClick(ListView1.SelectedItem)
End Sub

Private Sub ListView1_DblClick()
    If UBound(BpFile, 1) = 0 Then Exit Sub
    Call Command1_Click(0)
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
    If UBound(BpFile, 1) = 0 Then Exit Sub
    Dim Sel_File As Integer
    With ListView1
        .ListItems(.Tag).SmallIcon = 2
        .SelectedItem.SmallIcon = 1
        .Tag = .SelectedItem.Key
    End With
    Sel_File = Val(Right(Item.Key, Len(Item.Key) - 1))
    Label1(0).Caption = BpFile(Sel_File).UseDate
    Label1(1).Caption = BpFile(Sel_File).BackupDate
    Label1(2).Caption = BpFile(Sel_File).BackupUser
    Text1(1).Text = BpFile(Sel_File).Demo
    NamFileName = BpFile(Sel_File).BackupFile
End Sub

Private Sub Text1_GotFocus(Index As Integer)
    Text1(Index).SelStart = 0
    Text1(Index).SelLength = Len(Text1(Index).Text)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Set Fs = Nothing
End Sub