frmreloaddata.frm

是一款经典的图书管理系统

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Begin VB.Form frmreloaddata 
   Caption         =   "正在恢复数据，请稍等..."
   ClientHeight    =   2700
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4635
   LinkTopic       =   "Form1"
   ScaleHeight     =   2700
   ScaleWidth      =   4635
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   2745
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4695
      Begin VB.CommandButton Command4 
         Caption         =   "..."
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   7.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   345
         Left            =   3930
         TabIndex        =   5
         Top             =   1020
         Width           =   375
      End
      Begin VB.TextBox txtpathText 
         Height          =   324
         Left            =   210
         TabIndex        =   4
         Top             =   1020
         Width           =   3705
      End
      Begin VB.CommandButton Command1 
         Caption         =   "开始恢复数据"
         Default         =   -1  'True
         Height          =   405
         Left            =   510
         TabIndex        =   2
         Top             =   2160
         Width           =   1395
      End
      Begin VB.CommandButton Command2 
         Cancel          =   -1  'True
         Caption         =   "取消恢复数据"
         Height          =   405
         Left            =   2580
         TabIndex        =   1
         Top             =   2160
         Width           =   1395
      End
      Begin MSComctlLib.ProgressBar MyBar 
         Height          =   285
         Left            =   210
         TabIndex        =   3
         Top             =   1680
         Width           =   4125
         _ExtentX        =   7276
         _ExtentY        =   503
         _Version        =   393216
         Appearance      =   1
      End
      Begin VB.Label lblShowInfo 
         Height          =   255
         Left            =   210
         TabIndex        =   8
         Top             =   1470
         Width           =   4035
      End
      Begin VB.Label Label3 
         Caption         =   "请输入备份数据表所在的目录："
         Height          =   330
         Left            =   210
         TabIndex        =   7
         Top             =   750
         Width           =   3030
      End
      Begin VB.Label Label2 
         Caption         =   "注意：数据恢复将删除现存的数据，而将以前备份到硬盘的数据恢复到如今库中！"
         ForeColor       =   &H8000000D&
         Height          =   435
         Left            =   240
         TabIndex        =   6
         Top             =   270
         Width           =   4095
      End
   End
End
Attribute VB_Name = "frmreloaddata"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
    m_iBeginSaveTimer = 0
    Dim respond As Integer
    respond = MsgBox("恢复数据将改写全部数据库现有数据，是否继续？", 64 + 4, "是否确认")
    If respond = 7 Then
        Exit Sub
    End If
    If (Len(Trim(txtpathText.Text)) = 0) Then
        Result = MsgBox("请指定所要备份数据的路径!", vbOKOnly, "数据备份")
        Exit Sub
    Else
        If (Right(Trim(txtpathText.Text), 1) <> "\") Then
            txtpathText.Text = Trim(txtpathText.Text) + "\"
        Else
            txtpathText.Text = Trim(txtpathText.Text)
        End If
        If (Dir(txtpathText.Text, vbDirectory) = "") Then
            Result = MsgBox("指定路径不存在!", vbOKOnly, "数据备份")
            Exit Sub
        End If
        
    End If
    
    On Error GoTo ErrorHand
    '连接数据库
    
    Dim strFileName As String
    Dim strTableName As String
    Dim sqlname As String
    Dim rsColumnName As New ADODB.Recordset
    Dim rs As New ADODB.Recordset
    Dim rsData As New ADODB.Recordset
    
    strFileName = Dir(Trim(txtpathText.Text) + "*.dat")
    If strFileName = "" Then
        MsgBox "该处不包含所要恢复数据的备份文件！", 64, "数据恢复"
        MousePointer = 1
        Exit Sub
    End If
    Dim nreccount As Long
    Dim bOK As Boolean
    '开始一个事务
    cnnJLDB.BeginTrans
    Do While strFileName <> ""
        If strFileName <> "dtproperties.dat" Then
            bOK = False
            strTableName = Left(strFileName, Len(strFileName) - 4)
            '先删除该表的数据
            sqlname = "truncate Table " + Trim(strTableName)
            cnnJLDB.Execute sqlname
            '然后开始备份
            sqlname = "select * from sysobjects Where type = 'u' and name ='" + strTableName + "'"
            
            rs.Open sqlname, cnnJLDB, adOpenStatic, adLockReadOnly
            If Not rs.EOF Then
                bOK = True
            End If
            rs.Close
            If bOK = True Then
                MousePointer = 11
                '---------------------------------------------------------------------------
                '根据表名确定各个域名及域类型
                sqlname = "select xtype,length,name from syscolumns where id in (select id from sysobjects where name = '" + strTableName + "')"
                rsColumnName.Open sqlname, cnnJLDB, adOpenStatic, adLockReadOnly
                nreccount = 0
                If Not rsColumnName.EOF Then
                    rsColumnName.MoveLast
                    nreccount = rsColumnName.RecordCount
                    rsColumnName.MoveFirst
                End If
                rsColumnName.Close
                '将指定文件数据恢复到数据库中
                sqlname = "select * from " + Trim(strTableName)
                rsData.Open sqlname, cnnJLDB, adOpenKeyset, adLockOptimistic
                lblShowInfo.Caption = "正在恢复" + strTableName + "表中的数据..."
                lblShowInfo.Refresh
                Open Trim(txtpathText.Text) + strFileName For Binary As #1
                Dim lRecordNum As Long
                Dim n As Long
                Get #1, , lRecordNum
                If lRecordNum < 10000 Then
                    MyBar.Max = lRecordNum + 1
                Else
                    MyBar.Max = lRecordNum \ 100
                End If
                MyBar.Value = 0
                If (lRecordNum > 0) Then
                    For n = 1 To lRecordNum
                        rsData.AddNew
                        For nStep = 0 To nreccount - 1
                            Get #1, , fieldData
                            rsData(nStep) = fieldData
                        Next nStep
                        rsData.Update
                        m_iBeginSaveTimer = 0
                        If lRecordNum < 10000 Then
                            MyBar.Value = MyBar.Value + 1
                        Else
                            If n Mod 100 = 1 Then
                                MyBar.Value = MyBar.Value + 1
                            End If
                        End If
                    Next n
                    Close #1
                Else
                    Close #1
                End If
                rsData.Close
            End If
        End If
        '---------------------------------------------------------------------------
        strFileName = Dir
    Loop
    lblShowInfo.Caption = "数据恢复完毕！"
    lblShowInfo.Refresh
    MousePointer = 1
    cnnJLDB.CommitTrans
    MsgBox "数据恢复完毕!", , "信息提示"
    Unload Me
    Exit Sub
ErrorHand:
    cnnJLDB.RollbackTrans
    MousePointer = 1
    MsgBox "数据恢复失败，请联系开发人员！", 64, "数据恢复"

End Sub

Private Sub Command2_Click()
    SaveSetting App.Title, "Settings", "StoreDirection", Trim(txtpathText.Text)
    Unload Me
End Sub

Private Sub Command4_Click()
    frmopendir.Show 1
    txtpathText.Text = frmopendir.strSelDir
End Sub

Private Sub Form_Load()
    m_iBeginSaveTimer = 0
    m_bHaveDone = False
    txtpathText.Text = GetSetting(App.Title, "Settings", "StoreDirection", "d:\temp")

End Sub

Private Sub Form_Unload(Cancel As Integer)
    m_iBeginSaveTimer = 0

End Sub