frmreloaddata.frm

针对于订房中心的酒店合同管理。管理权限有管理员和业务员等。

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmreloaddata 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "正在恢复数据请稍等..."
   ClientHeight    =   2745
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4290
   Icon            =   "frmreloaddata.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2745
   ScaleWidth      =   4290
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   2655
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   4095
      Begin VB.CommandButton Command2 
         Caption         =   "取消恢复数据"
         Height          =   375
         Left            =   2160
         TabIndex        =   7
         Top             =   2040
         Width           =   1695
      End
      Begin VB.CommandButton Command1 
         Caption         =   "开始恢复数据"
         Default         =   -1  'True
         Height          =   375
         Left            =   240
         TabIndex        =   6
         Top             =   2040
         Width           =   1695
      End
      Begin MSComctlLib.ProgressBar MyBar 
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   1560
         Width           =   3855
         _ExtentX        =   6800
         _ExtentY        =   450
         _Version        =   393216
         Appearance      =   1
      End
      Begin VB.CommandButton Command4 
         Caption         =   "..."
         Height          =   375
         Left            =   3360
         TabIndex        =   4
         Top             =   960
         Width           =   495
      End
      Begin VB.TextBox txtpathText 
         Height          =   375
         Left            =   120
         TabIndex        =   3
         Top             =   960
         Width           =   3015
      End
      Begin VB.Label Label2 
         Caption         =   "请输入备份数据表所在的目录："
         Height          =   255
         Left            =   120
         TabIndex        =   2
         Top             =   720
         Width           =   2655
      End
      Begin VB.Label Label1 
         Caption         =   "注意：数据恢复将删除现存的数据，而将以前备份到硬盘的数据恢复到如今库中！"
         ForeColor       =   &H00800000&
         Height          =   375
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   3855
      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