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