VERSION 5.00
Begin VB.Form BACKUP 
   Caption         =   "數據備份"
   ClientHeight    =   3450
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5490
   Icon            =   "backup.frx":0000
   ScaleHeight     =   3450
   ScaleWidth      =   5490
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   4140
      TabIndex        =   5
      Text            =   "Combo1"
      Top             =   1740
      Visible         =   0   'False
      Width           =   1275
   End
   Begin VB.CommandButton Command2 
      Caption         =   "取 消"
      Height          =   375
      Left            =   4200
      TabIndex        =   4
      Top             =   960
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "備 份"
      Height          =   375
      Left            =   4200
      TabIndex        =   3
      Top             =   420
      Width           =   975
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   180
      TabIndex        =   1
      Top             =   420
      Width           =   3615
   End
   Begin VB.DirListBox Dir1 
      Height          =   2400
      Left            =   180
      TabIndex        =   0
      Top             =   840
      Width           =   3615
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "請選擇備份目錄:"
      Height          =   315
      Left            =   240
      TabIndex        =   2
      Top             =   120
      Width           =   1575
   End
End
Attribute VB_Name = "BACKUP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DATBAK As Database
Dim RECBACKUP As Recordset
Dim BFPATH As String
Public BFFILE As String
Public DISKS As Integer
Public Function BFILEEXISTS(SFILE As String) As Boolean
    If Dir$(SFILE) <> "" Then BFILEEXISTS = True Else BFILEEXISTS = False
End Function

Private Sub Command1_Click()
    On Error GoTo LOCALERR
    RECBACKUP.FindFirst "ID = 13"
    If Not RECBACKUP.NoMatch Then
       BFPATH = RECBACKUP("CS")
       If left(BFPATH, 1) = "'" Then BFPATH = right(BFPATH, Len(BFPATH) - 1)
       If right(BFPATH, 1) = "'" Then BFPATH = left(BFPATH, Len(BFPATH) - 1)
       If Not BFILEEXISTS(BFPATH) Then
          MsgBox "指定的數據文件未找到,無法繼續!", vbCritical, "錯誤"
          Exit Sub
       End If
       Else
         MsgBox "系統數據內部錯誤,無法繼續!", vbCritical, "錯誤"
         Unload BACKUP
    End If
    RECBACKUP.FindFirst "ID = 4"
    If Not RECBACKUP.NoMatch Then
       RECBACKUP.Edit
       If UCase(left(Dir1.Path, 1)) = "A" Then RECBACKUP("CS") = ".Set MaxDiskSize=1024000" _
          Else RECBACKUP("CS") = ".Set MaxDiskSize=CDROM"
       RECBACKUP.Update
       Else
         MsgBox "系統數據內部錯誤,無法繼續!", vbCritical
         Unload BACKUP
    End If
    RECBACKUP.FindFirst "ID = 10"
    If Not RECBACKUP.NoMatch Then
       RECBACKUP.Edit
       If UCase(left(Dir1.Path, 1)) = "A" Then
          RECBACKUP("CS") = ".Set CabinetNameTemplate='BACKUP\" + Trim(RECBACKUP("FILE")) + "'"
          Else
            If right(Dir1.Path, 1) = "\" Then RECBACKUP("CS") = ".Set CabinetNameTemplate='" & Dir1.Path & Trim(RECBACKUP("FILE")) & "'" _
               Else RECBACKUP("CS") = ".Set CabinetNameTemplate='" & Dir1.Path & "\" & Trim(RECBACKUP("FILE")) & "'"
       End If
       RECBACKUP.Update
       Else
         MsgBox "系統數據內部錯誤,無法繼續!", vbCritical
         Unload BACKUP
    End If
    NFILE = FreeFile
    Open App.Path & "\BACKUP.DDF" For Output As #NFILE
    RECBACKUP.MoveFirst
    Do While Not RECBACKUP.EOF()
       Print #NFILE, RECBACKUP("CS")
       RECBACKUP.MoveNext
    Loop
    Close #NFILE
    ChDrive left(App.Path, 2)
    ChDir App.Path
    If BFILEEXISTS("BACKUP\*.*") Then Kill "BACKUP\*.*"
    If BFILEEXISTS("SETUP.INF") And BFILEEXISTS("SETUP.RPT") Then Kill "SETUP.*"
    If BFILEEXISTS("BACKUP.WC_") Then Kill "BACKUP.WC_"
    NFILE = FreeFile
    Open App.Path & "\BACKUP.BAT" For Output As #NFILE
    If UCase(left(Dir1.Path, 1)) <> "A" Then
       Print #NFILE, "MAKECAB /F BACKUP.DDF>BACKUP.WC_"
       Else
         Print #NFILE, "MAKECAB /L BACKUP /F BACKUP.DDF>BACKUP.WC_"
    End If
    Close #NFILE
    Shell "BACKUP.BAT", vbHide
    Load JDT
    JDT.Show vbModal
    If UCase(left(Dir1.Path, 1)) <> "A" Then
'       If BFILEEXISTS("BACKUP.DDF") Then Kill "BACKUP.DDF"
'       If BFILEEXISTS("BACKUP.BAT") Then Kill "BACKUP.BAT"
       If BFILEEXISTS("SETUP.INF") And BFILEEXISTS("SETUP.RPT") Then Kill "SETUP.*"
       If BFILEEXISTS("BACKUP.WC_") Then Kill "BACKUP.WC_"
       If JDT.STRERROR = "" Then
          MsgBox "恭喜!您的數據已安全備份...", vbInformation + vbOKOnly, "提示信息"
       End If
       GoTo LOCALEXIT
    End If
    SNEXTFILE = Dir$("BACKUP\*.*")
    Dim DD As String
    While SNEXTFILE <> ""
          Combo1.AddItem (Trim(SNEXTFILE))
          SNEXTFILE = Dir$
    Wend
    DISKS = 1
    Do While DISKS <= Combo1.ListCount
       BFFILE = Combo1.List(DISKS - 1)
COPY:
        SFBF = MsgBox("此次備份共需" + CStr(Combo1.ListCount) + "張空白高密軟盤," + Chr(13) + "請準備好備份盤,并填寫好標簽。" _
               + Chr(13) + Chr(13) + "Please Insert Disk:#" + CStr(DISKS), vbInformation + vbOKCancel, "提示信息")
        If SFBF = vbOK Then
           If BFILEEXISTS("A:\*.*") Then
              SFSC = MsgBox("A:盤中有文件,是否換盤再試?", vbQuestion + vbYesNo, "提示信息")
              If SFSC = vbYes Then GoTo COPY Else GoTo LOCALEXIT
           End If
           Load BFJDT
           BFJDT.Show vbModal
           Else
             GoTo LOCALEXIT
        End If
        DISKS = DISKS + 1
    Loop
    If BFILEEXISTS("BACKUP.DDF") Then Kill "BACKUP.DDF"
    If BFILEEXISTS("BACKUP.BAT") Then Kill "BACKUP.BAT"
    If BFILEEXISTS("SETUP.INF") And BFILEEXISTS("SETUP.RPT") Then Kill "SETUP.*"
    If BFILEEXISTS("BACKUP.WC_") Then Kill "BACKUP.WC_"
    MsgBox "恭喜!您的數據已安全備份...", vbInformation + vbOKOnly, "提示信息"
    GoTo LOCALEXIT
    
LOCALERR:
    If Err.Number = 68 Then
       MsgBox "磁盤驅動器設備不能用,請換盤再試", vbCritical, "錯誤"
       Resume
    End If
    If Err.Number = 70 Then
       MsgBox "驅動器拒絕訪問或磁盤被寫保防,請換盤再試", vbCritical, "錯誤"
       Resume
    End If
    
    strmsg = CStr(Err.Number) & "-" & Err.Description
    SFXX = MsgBox(strmsg, vbCritical + vbRetryCancel, "錯誤")
    If SFXX = vbRetry Then
       Resume
       Else
         Unload BACKUP
    End If

LOCALEXIT:
    Unload BACKUP
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Drive1_Change()
    On Error GoTo LOCALERR
    Dir1.Path = Drive1.Drive
    GoTo LOCALEXIT
    
LOCALERR:
    If Err.Number = 68 Then
       MsgBox "磁盤驅動器設備不能用,請換盤再試", vbCritical, "錯誤"
       Resume
    End If
    strmsg = CStr(Err.Number) & "-" & Err.Description
    SFXX = MsgBox(strmsg, vbCritical + vbAbortRetryIgnore, "錯誤")
    If SFXX = vbRetry Then
       Resume
       Else
         Unload BACKUP
    End If
    

LOCALEXIT:

End Sub

Private Sub Form_Load()
    SFOK = 100
    Set DATBAK = OpenDatabase(App.Path & "\BACKUP.MDB")
    Set RECBACKUP = DATBAK.OpenRecordset("BACKUP", dbOpenDynaset)
'    RECBACKUP.FindFirst ("ID=13")
'    RECBACKUP.Edit
'    RECBACKUP("CS") = App.Path & "\DATA\GRSDS.MDB"
'    RECBACKUP.Update
'    RECBACKUP.MoveFirst
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DATBAK.Close
End Sub