On Error Resume Next
    
    Dim Msg As String
    Dim Fso As FileSystemObject
    Dim ThisDisk As Drive
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set ThisDisk = Fso.GetDrive(Fso.GetDriveName(Drive.Drive))
    With ThisDisk
        If .DriveType <> 4 Then
            MsgBox "請選擇可擦寫光驅！", vbInformation
            GetCD_RomInfo = False
            Exit Function
        End If
        If .IsReady = False Then
1:          Msg = MsgBox("請插入光盤,按[確定]繼續!", vbYesNo + vbInformation)
            Select Case Msg
            Case vbYes
                If .IsReady = False Then
                    GoTo 1
                End If
            Case vbNo
                GetCD_RomInfo = False
                Exit Function
            End Select
        End If
        frmStep22.Caption = "備份光盤信息"
        lblHDInfoL.Caption = "備份光盤盤符:"
        lblHDFreeSizeL.Caption = "備份光盤剩余空間:"
        lblDiskInfo.Caption = .DriveLetter
        lblFreeSpace.Caption = vbNullString
        lblFreeSpace.Caption = Int(.AvailableSpace / (1024 ^ 2))
    End With
    GetCD_RomInfo = True
    
End Function

Private Sub CmdPrevious_Click()

    '根據不同的步驟,顯示不同的控件
    If Step2 Then
        cmdPrevious.Visible = False
        frmStep1.Visible = True
        frmStep21.Visible = False
        frmStep22.Visible = False
        frmStep3.Visible = False
        Step1 = True
        Step2 = False
        Step3 = False
        Exit Sub
    End If
    If Step3 Then
        cmdPrevious.Visible = True
        frmStep1.Visible = False
        frmStep21.Visible = True
        frmStep22.Visible = True
        frmStep3.Visible = False
        Step1 = False
        Step2 = True
        Step3 = False
    End If

End Sub

Private Function CheckSize() As Boolean
    If Val(lblFileNum.Caption) + csDiskRemain >= Val(lblFreeSpace.Caption) Then
        CheckSize = False
    Else
        CheckSize = True
    End If
End Function

Private Sub CmdSelePath_Click()
    frmFindPath.Show vbModal
    txtPath.Text = frmFindPath.ThisPath
    
End Sub

Private Sub Form_Load()

    '初始化所屬時期
    txtSSSQHD1.Text = Year(DateAdd("M", -1, Date)) & Format(Month(DateAdd("M", -1, Date)), "0#")
    txtSSSQHD2.Text = Year(Date) & Format(Month(Date), "0#")
    txtSSSQCD1.Text = txtSSSQHD1.Text
    txtSSSQCD2.Text = txtSSSQHD2.Text
    
    '取得上一次備份時的選擇(備份至其他路徑或光盤)
    Dim LastChoice As String
    LastChoice = GetSetting(App.Title, "Settings", "LastChoice", "CD")
    If LastChoice = "CD" Then
        OptBkToCD.Value = True
        OptBkToHD.Value = False
    Else
        OptBkToHD.Value = True
        OptBkToCD.Value = False
    End If
    
    '現在是第一步
    Step1 = True
    cmdPrevious.Visible = False
    frmStep1.Visible = True
    frmStep21.Visible = False
    frmStep22.Visible = False
    frmStep3.Visible = False
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    '保存本次備份的選擇
    If OptBkToHD.Value = True Then
        SaveSetting App.Title, "Settings", "LastChoice", "HD"
    Else
        SaveSetting App.Title, "Settings", "LastChoice", "CD"
    End If
    Unload Me
End Sub

Private Sub OptBkToCD_Click()
    
    '初始化界面
    txtSSSQCD1.Enabled = True
    txtSSSQCD2.Enabled = True
    txtSSSQCD1.BackColor = &H80000005
    txtSSSQCD2.BackColor = &H80000005
    UpDCD1.Enabled = True
    UpDCD2.Enabled = True
    chkRegToCD.Enabled = True
    Drive.Enabled = True
    Drive.BackColor = &H80000005
    
    txtPath.Enabled = False
    CmdSelePath.Enabled = False
    txtSSSQHD1.Enabled = False
    txtSSSQHD2.Enabled = False
    txtPath.BackColor = &H8000000F
    txtSSSQHD1.BackColor = &H8000000F
    txtSSSQHD2.BackColor = &H8000000F
    UpDHD1.Enabled = False
    UpDHD2.Enabled = False
    chkRegToHD.Enabled = False
    
End Sub

Private Sub OptBkToHD_Click()

    '初始化界面
    txtPath.Enabled = True
    CmdSelePath.Enabled = True
    txtSSSQHD1.Enabled = True
    txtSSSQHD2.Enabled = True
    txtPath.BackColor = &H80000005
    txtSSSQHD1.BackColor = &H80000005
    txtSSSQHD2.BackColor = &H80000005
    UpDHD1.Enabled = True
    UpDHD2.Enabled = True
    chkRegToHD.Enabled = True
    
    txtSSSQCD1.Enabled = False
    txtSSSQCD2.Enabled = False
    txtSSSQCD1.BackColor = &H8000000F
    txtSSSQCD2.BackColor = &H8000000F
    UpDCD1.Enabled = False
    UpDCD2.Enabled = False
    chkRegToCD.Enabled = False
    Drive.Enabled = False
    Drive.BackColor = &H8000000F
    
End Sub

Private Sub UpDHD1_DownClick()
    Dim tmpDate As String
    
    tmpDate = DateValue(Left(txtSSSQHD1, 4) & "/" & Right(txtSSSQHD1, 2) & "/01")
    txtSSSQHD1.Text = Year(DateAdd("M", -1, tmpDate)) & Format(Month(DateAdd("M", -1, tmpDate)), "0#")
End Sub

Private Sub UpDHD1_UpClick()
    Dim tmpDate As String
    
    tmpDate = DateValue(Left(txtSSSQHD1, 4) & "/" & Right(txtSSSQHD1, 2) & "/01")
    txtSSSQHD1.Text = Year(DateAdd("M", 1, tmpDate)) & Format(Month(DateAdd("M", 1, tmpDate)), "0#")
End Sub

Private Sub UpDHD2_DownClick()
    Dim tmpDate As String
    
    tmpDate = DateValue(Left(txtSSSQHD2, 4) & "/" & Right(txtSSSQHD2, 2) & "/01")
    txtSSSQHD2.Text = Year(DateAdd("M", -1, tmpDate)) & Format(Month(DateAdd("M", -1, tmpDate)), "0#")
End Sub

Private Sub UpDHD2_UpClick()
    Dim tmpDate As String
    
    tmpDate = DateValue(Left(txtSSSQHD2, 4) & "/" & Right(txtSSSQHD2, 2) & "/01")
    txtSSSQHD2.Text = Year(DateAdd("M", 1, tmpDate)) & Format(Month(DateAdd("M", 1, tmpDate)), "0#")
End Sub

Private Sub UpDCD1_DownClick()
    Dim tmpDate As String
    
    tmpDate = DateValue(Left(txtSSSQCD1, 4) & "/" & Right(txtSSSQCD1, 2) & "/01")
    txtSSSQCD1.Text = Year(DateAdd("M", -1, tmpDate)) & Format(Month(DateAdd("M", -1, tmpDate)), "0#")
End Sub

Private Sub UpDCD1_UpClick()
    Dim tmpDate As String
    
    tmpDate = DateValue(Left(txtSSSQCD1, 4) & "/" & Right(txtSSSQCD1, 2) & "/01")
    txtSSSQCD1.Text = Year(DateAdd("M", 1, tmpDate)) & Format(Month(DateAdd("M", 1, tmpDate)), "0#")
End Sub

Private Sub UpDCD2_DownClick()
    Dim tmpDate As String
    
    tmpDate = DateValue(Left(txtSSSQCD2, 4) & "/" & Right(txtSSSQCD2, 2) & "/01")
    txtSSSQCD2.Text = Year(DateAdd("M", -1, tmpDate)) & Format(Month(DateAdd("M", -1, tmpDate)), "0#")
End Sub

Private Sub UpDCD2_UpClick()
    Dim tmpDate As String
    
    tmpDate = DateValue(Left(txtSSSQCD2, 4) & "/" & Right(txtSSSQCD2, 2) & "/01")
    txtSSSQCD2.Text = Year(DateAdd("M", 1, tmpDate)) & Format(Month(DateAdd("M", 1, tmpDate)), "0#")
End Sub

Private Function BackupToHD() As Boolean
'************************************************************************
'功能: 備份文書,包括復制文件到磁盤的指定目錄下,修改數據庫中的相應字段信息
'調用: cmdNext 的 Step3
'************************************************************************
On Error GoTo ErrorHandler
Dim ThisDisk As Drive

Me.MousePointer = vbHourglass
Set ThisDisk = Fso.GetDrive(Fso.GetDriveName(Left(txtPath.Text, 3)))

'在選定的目錄下建立備份目錄
If Right(txtPath, 1) <> "\" Then
    txtPath = txtPath & "\"
End If
If Dir(txtPath & txtSSSQCD1 & "_" & txtSSSQCD2, vbDirectory) = vbNullString Then
    MkDir (txtPath & txtSSSQCD1 & "_" & txtSSSQCD2)
Else
    Fso.DeleteFolder (txtPath & txtSSSQCD1 & "_" & txtSSSQCD2)
    MkDir (txtPath & txtSSSQCD1 & "_" & txtSSSQCD2)
End If

With rstBackupFile
    .MoveLast: .MoveFirst
    Do Until .EOF
        
        '復制文件
        If Dir(!Img_Path & !Img_Name) <> vbNullString Then
            FileCopy !Img_Path & !Img_Name, txtPath & txtSSSQCD1 & "_" & txtSSSQCD2 & "\" & !Img_Name
                
            '修改數據庫中相應字段信息
            !Img_BackupPath = txtPath & txtSSSQCD1 & "_" & txtSSSQCD2
            !Img_BackupMode = True
            !Img_BackupDate = Date
            .Update
        End If
        
        '移到下一條記錄
        .MoveNext
    Loop
    
End With

BackupToHD = True
Me.MousePointer = vbDefault

Exit Function
ErrorHandler:
    If Err Then
        MsgBox Err.Description, vbInformation
        Err.Clear
        BackupToHD = False
    End If
End Function

Private Function BackupToCD() As Boolean
'************************************************************************
'功能: 備份文書,包括復制文件到光盤的指定目錄下,修改數據庫中的相應字段信息
'調用: cmdNext 的 Step3
'************************************************************************
On Error GoTo ErrorHandler

Dim ThisDisk As Drive
Dim Msg As String

Me.MousePointer = vbHourglass
Set ThisDisk = Fso.GetDrive(Fso.GetDriveName(Drive.Drive))

'在光盤根目錄下建立備份目錄
If Dir(ThisDisk.DriveLetter & ":\" & txtSSSQCD1 & "_" & txtSSSQCD2, vbDirectory) <> vbNullString Then
    MkDir (ThisDisk.DriveLetter & ":\" & txtSSSQCD1 & "_" & txtSSSQCD2)
End If

With rstBackupFile
    .MoveLast: .MoveFirst
    Do Until .EOF
    
        '復制文件
        If Dir(!Img_Path & !Img_Name) <> vbNullString Then
            FileCopy !Img_Path & !Img_Name, ThisDisk.DriveLetter & ":\" & txtSSSQCD1 & "_" & txtSSSQCD2 & "\" & !Img_Name
        
            '檢查光盤剩余空間
            If ThisDisk.AvailableSpace < 10000000 Then
1:          Msg = MsgBox("光盤已滿，請插入新的光盤，按[確定]繼續", vbYesNo + vbExclamation)
                Select Case Msg
                Case vbYes
                    If ThisDisk.IsReady = True Then
                        
                    Else
                        GoTo 1
                    End If
                Case vbNo
                    MsgBox "本次備份未完成!", vbInformation
                    BackupToCD = False
                    Exit Function
                End Select
            End If
            
            '修改數據庫中相應字段信息
            !Img_BackupPath = ThisDisk.DriveLetter & ":\" & txtSSSQCD1 & "_" & txtSSSQCD2
            !Img_BackupMode = True
            !Img_BackupDate = Date
            .Update
        End If
        
        '移到下一條記錄
        .MoveNext
    Loop
    
End With

BackupToCD = True
Me.MousePointer = vbDefault

Exit Function
ErrorHandler:
    If Err Then
        MsgBox Err.Description, vbInformation
        Err.Clear
        BackupToCD = False
    End If
End Function