frmsavedata.frm

vb写的图书馆管理系统的源码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Begin VB.Form frmsavedata 
   Caption         =   "数据备份"
   ClientHeight    =   2250
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   5490
   LinkTopic       =   "Form1"
   ScaleHeight     =   2250
   ScaleWidth      =   5490
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   2205
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5445
      Begin VB.TextBox txtpathText 
         Height          =   324
         Left            =   1860
         TabIndex        =   5
         Top             =   330
         Width           =   3000
      End
      Begin VB.CommandButton Command1 
         Caption         =   "..."
         Height          =   345
         Left            =   4890
         TabIndex        =   4
         Top             =   330
         Width           =   435
      End
      Begin VB.CommandButton Command2 
         Cancel          =   -1  'True
         Caption         =   "放弃保存数据"
         Height          =   405
         Left            =   3120
         TabIndex        =   2
         Top             =   1560
         Width           =   1635
      End
      Begin VB.CommandButton Command3 
         Caption         =   "开始保存数据"
         Default         =   -1  'True
         Height          =   405
         Left            =   630
         TabIndex        =   1
         Top             =   1560
         Width           =   1635
      End
      Begin MSComctlLib.ProgressBar ProcessDataSave 
         Height          =   255
         Left            =   150
         TabIndex        =   3
         Top             =   1140
         Width           =   5115
         _ExtentX        =   9022
         _ExtentY        =   450
         _Version        =   393216
         Appearance      =   1
      End
      Begin VB.Label Label3 
         Caption         =   "请选择数据备份目录:"
         Height          =   330
         Left            =   90
         TabIndex        =   7
         Top             =   405
         Width           =   1815
      End
      Begin VB.Label lblShowInfo 
         ForeColor       =   &H00FF0000&
         Height          =   255
         Left            =   150
         TabIndex        =   6
         Top             =   870
         Width           =   5175
      End
   End
End
Attribute VB_Name = "frmsavedata"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_bHaveDone As Boolean


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

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Command3_Click()
    m_iBeginSaveTimer = 0
    Dim rsTableName As New ADODB.Recordset
    Dim rsColumnName As New ADODB.Recordset
    Dim rsData As New ADODB.Recordset
    Dim cnnJLDB As New ADODB.Connection
    
    Dim sqlname As String
    Dim strName As String
    
    Dim FieldType() As Integer
    Dim FieldLength() As Integer
    Dim FieldName() As String
    Dim FieldNote() As String
    
    cnnJLDB.Open "provider=Microsoft.Jet.OLEDB.4.0; data source=" & App.Path & "\database.mdb"
    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 strTableName As String
   ' Dim nreccount As Long
   ' Dim RecordSize As Integer
   ' sqlname = "select * from sysobjects Where type = 'u'"
  '  rsTableName.Open sqlname, cnnJLDB, adOpenStatic, adLockReadOnly
   ' While Not rsTableName.EOF
      '  strTableName = Trim(rsTableName!Name)
        '--------------------------------------------------------------------------
        '根据表名确定各个域名及域类型
        'sqlname = "select xtype,length,name from syscolumns where id in (select id from sysobjects where name = '" + strTableName + "')"
       ' rsColumnName.Open sqlname, cnnJLDB, adOpenStatic, adLockReadOnly
      '  rsColumnName.MoveLast
       ' nreccount = rsColumnName.RecordCount
    ''
        'ReDim FieldType(nreccount)
       ' ReDim FieldLength(nreccount)
       ' ReDim FieldName(nreccount)
       ' ReDim FieldNote(nreccount)
            
      '  rsColumnName.MoveFirst
        
       ' RecordSize = 0
       ' While Not rsColumnName.EOF
            'nIndex = rsColumnName.AbsolutePosition
           ' FieldLength(nIndex) = rsColumnName!Length
            'RecordSize = RecordSize + rsColumnName!Length
           ' FieldType(nIndex) = rsColumnName!xtype
           ' FieldName(nIndex) = rsColumnName!Name
           ' rsColumnName.MoveNext
        'Wend
       ' rsColumnName.Close
       ' Open txtpathText.Text + strTableName + ".dat" For Binary As #1
        
        '从表中读纪录
       ' sqlname = "select * from " + Trim(strTableName)
        'rsData.Open sqlname, cnnJLDB, adOpenStatic, adLockReadOnly
       ' lblShowInfo.Caption = "正在备份数据库中表" + Trim(TableName) + "的数据..."
        'lblShowInfo.Refresh
        'ProcessDataSave.Min = 0
       ' Dim lRowCount As Long
       ' Dim n As Long
       ' lRowCount = 0
       ' If Not rsData.EOF Then
           ' rsData.MoveLast
          '  lRowCount = rsData.RecordCount
            'rsData.MoveFirst
        'End If
        'If lRowCount = 0 Then
           ' ProcessDataSave.Max = 1
           ' ProcessDataSave.Value = 1
           ' lblShowInfo.Caption = strTableName + "表没有纪录!"
        'Else
           ' ProcessDataSave.Max = lRowCount
            'ProcessDataSave.Value = ProcessDataSave.Min
        'End If
        'Put #1, , lRowCount
        'For n = 1 To lRowCount
            'lblShowInfo.Caption = "正在备份数据库中表" + strTableName + "的数据:" + Format(n) + "/" + Format(lRowCount)
           ' lblShowInfo.Refresh
           ' For nStep = 0 To nreccount - 1
                'fieldData = rsData(nStep)
                'Put #1, , fieldData
           ' Next nStep
            'ProcessDataSave.Value = n
           'm_iBeginSaveTimer = 0
            'rsData.MoveNext
       'Next n
        'rsData.Close
       ' Close #1
    'rsTableName.MoveNext
    'Wend
    'rsTableName.Close
    'm_bHaveDone = True
    'MousePointer = 1
    'Result = MsgBox("本系统数据库中的数据备份完毕，请保存数据备份目录下的数据备份文件!", vbOKOnly, "数据备份")
    
   'SaveSetting App.Title, "Settings", "StoreDirection", Trim(txtpathText.Text)

   ' Unload Me
    
    'Exit Sub
ErrorHand:
    MousePointer = 1
    MsgBox "数据备份失败，请重试，必要时联系开发人员！", 64, "信息提示"

End Sub

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

Private Sub Form_Unload(Cancel As Integer)
    m_iBeginSaveTimer = 0
    Dim iRespond As Integer
    If m_bHaveDone = False Then  '如果还没有备份完数据
        iRespond = MsgBox("是否确认取消数据备份?", 64 + 4, "信息提示")
        If iRespond = 7 Then
            Cancel = -1
        End If
    End If
End Sub