backup.frm

光盘管家

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Backup 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "选择磁盘供备份"
   ClientHeight    =   3045
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3735
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3045
   ScaleWidth      =   3735
   StartUpPosition =   3  'Windows Default
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   315
      Left            =   120
      TabIndex        =   5
      Top             =   2640
      Visible         =   0   'False
      Width           =   3465
      _ExtentX        =   6112
      _ExtentY        =   556
      _Version        =   393216
      Appearance      =   0
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   120
      TabIndex        =   4
      Top             =   2640
      Width           =   2295
   End
   Begin VB.CommandButton Command2 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   2640
      TabIndex        =   2
      Top             =   840
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   2640
      TabIndex        =   1
      Top             =   360
      Width           =   975
   End
   Begin VB.DirListBox Dir1 
      Height          =   2190
      Left            =   120
      TabIndex        =   0
      Top             =   360
      Width           =   2295
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "选择"
      Height          =   180
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   360
   End
End
Attribute VB_Name = "Backup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim Directory As String
Dim lSec As Long, lSecSpace As Long, lLastJ As Long, lct As Long, lTotalJ As Long
On Error GoTo Errorhandle
Directory = Trim(Dir1.Path)
If vbNo = MsgBox("备份选定文件到 " + Directory + Chr(13) + Chr(13) + "忠告:不推荐直接将文件备份至软盘！" + Chr(13) + "最好将文件备份至硬盘，然后用ZIP压缩！" + Chr(13) + Chr(13) + "是否要备份?", vbYesNo + vbExclamation) Then
   Exit Sub
End If
Me.MousePointer = 11
Me.Caption = "正在备份中......"
If Right(Directory, 1) <> "\" Then
   Directory = Directory + "\"
End If
sdrive = Left(Directory, 3)
Me.ProgressBar1.Max = UBound(BackupFileArray)
Me.ProgressBar1.Visible = True
For i = 1 To UBound(BackupFileArray)
Repdisk:
    lct = GetDiskFreeSpace(sdrive, lSec, lSecSpace, lLastJ, lTotalJ)
    If lct = 0 Then
       GoTo Errorhandle
    Else
      lct = lSec * lSecSpace * lLastJ
    End If
    If lct < FileLen(BackupFileArray(i)) Then
       If vbYes = MsgBox("磁盘已满,请更换新盘!" + Chr(13) + Chr(13) + "继续备份吗?　按<否>可中断!", vbYesNo + vbQuestion) Then
          GoTo Repdisk
       Else
          Me.Caption = "选择磁盘供备份"
          Me.ProgressBar1.Visible = False
          Me.MousePointer = 0
          Exit Sub
       End If
    End If
    FileCopy BackupFileArray(i), Directory + BackupFileArray(i)
    If Right(BackupFileArray(i), 3) = "cdo" Then
       FileCopy BackupFileArray(i), Directory + BackupFileArray(i)
       mxfile = Left(BackupFileArray(i), Len(BackupFileArray(i)) - 3) + "mx"
       If Dir(mxfile) <> "" Then
          FileCopy mxfile, Directory + mxfile
       End If
    End If
     Me.ProgressBar1.Value = i
Next
Me.ProgressBar1.Visible = False
Me.Dir1.Visible = True
Me.MousePointer = 0
MsgBox "恭喜,备份完成啦!", vbInformation
Unload Me
Errorhandle:
If Err.Number = 75 Then
   Me.Caption = "选择磁盘供备份"
   Me.ProgressBar1.Visible = False
   Me.MousePointer = 0
   MsgBox "不能存储文件，请检查你有否在此磁盘上有存储文件的权力！", vbCritical
End If
If Err.Number = 70 Then
   Me.Caption = "选择磁盘供备份"
   Me.ProgressBar1.Visible = False
   Me.MousePointer = 0
   MsgBox "磁盘被写保护，或不允许写入", vbCritical
End If
End Sub

Private Sub Command2_Click()
Unload Me
End Sub



Private Sub Dir1_Change()
Label1.Caption = Dir1.Path
End Sub

Private Sub Drive1_Change()
On Error GoTo Errorhandle
Dir1.Path = Drive1.Drive
Exit Sub
Errorhandle:
Select Case Err.Number
       Case 52
            MsgBox "指定的磁盘驱动器不可用!" + Chr(13) + Chr(13) + "可能不存在此驱动器或驱动器内无磁盘!", vbCritical
       Case 57
            MsgBox "磁盘I/0错误，操作被终止!", vbCritical
       Case 61
            MsgBox "磁盘满，空间不够!", vbCritical
       Case 68
            MsgBox "磁盘没有放入驱动器中!请检查一下吧!", vbCritical
       Case 70
            MsgBox "磁盘被写保护 或 文件被保护!", vbCritical
       Case 71
            MsgBox "磁盘没准备好!", vbCritical
End Select

End Sub

Private Sub Form_Load()
CencerForm Me
Label1.Caption = Dir1.Path
End Sub