frmimgbackup.frm

用vb6.0实现的一个可以通用的企业档案管理系统。

         Height          =   180
         Left            =   585
         TabIndex        =   8
         Top             =   2250
         Width           =   2880
      End
      Begin VB.Label Label3 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         Caption         =   "备份目录为"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   180
         Left            =   570
         TabIndex        =   7
         Top             =   750
         Width           =   900
      End
   End
   Begin VB.Frame frmStep21 
      Caption         =   "备份文件信息"
      Height          =   1635
      Left            =   150
      TabIndex        =   21
      Top             =   135
      Width           =   6105
      Begin VB.Label lblFileSize 
         Alignment       =   1  'Right Justify
         BorderStyle     =   1  'Fixed Single
         Caption         =   "FileSize"
         Height          =   300
         Left            =   2100
         TabIndex        =   29
         Top             =   840
         Width           =   1995
      End
      Begin VB.Label lblFileNum 
         Alignment       =   1  'Right Justify
         BorderStyle     =   1  'Fixed Single
         Caption         =   "FileNumber"
         Height          =   300
         Left            =   2100
         TabIndex        =   28
         Top             =   390
         Width           =   1995
      End
      Begin VB.Label lblBkFileNumL 
         AutoSize        =   -1  'True
         Caption         =   "备份文件数量"
         Height          =   180
         Left            =   480
         TabIndex        =   23
         Top             =   450
         Width           =   1080
      End
      Begin VB.Label lblBkFileLenL 
         AutoSize        =   -1  'True
         Caption         =   "备份文件大小"
         Height          =   180
         Left            =   480
         TabIndex        =   22
         Top             =   870
         Width           =   1080
      End
   End
   Begin VB.Frame frmStep22 
      Caption         =   "备份磁盘信息"
      Height          =   1815
      Left            =   150
      TabIndex        =   24
      Top             =   1890
      Width           =   6105
      Begin VB.Label lblFreeSpace 
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Caption         =   "DiskFreeSpace"
         Height          =   315
         Left            =   2100
         TabIndex        =   31
         Top             =   810
         Width           =   1995
      End
      Begin VB.Label lblDiskInfo 
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Caption         =   "DiskInformation"
         Height          =   315
         Left            =   2100
         TabIndex        =   30
         Top             =   360
         Width           =   1995
      End
      Begin VB.Label lblHDInfoL 
         AutoSize        =   -1  'True
         Caption         =   "备份磁盘路径"
         Height          =   180
         Left            =   510
         TabIndex        =   26
         Top             =   420
         Width           =   1080
      End
      Begin VB.Label lblHDFreeSizeL 
         AutoSize        =   -1  'True
         Caption         =   "备份磁盘剩余空间"
         Height          =   180
         Left            =   510
         TabIndex        =   25
         Top             =   870
         Width           =   1440
      End
   End
   Begin VB.Frame frmStep3 
      Caption         =   "开始备份"
      Height          =   3555
      Left            =   150
      TabIndex        =   32
      Top             =   150
      Width           =   6105
      Begin VB.PictureBox picBegin 
         Height          =   3015
         Left            =   240
         ScaleHeight     =   2955
         ScaleWidth      =   1560
         TabIndex        =   33
         Top             =   330
         Width           =   1620
      End
      Begin VB.Label lblStep3 
         AutoSize        =   -1  'True
         Caption         =   "现在可以开始备份,请按[下一步]继续"
         Height          =   690
         Left            =   2145
         TabIndex        =   34
         Top             =   360
         Width           =   2970
      End
   End
End
Attribute VB_Name = "frmImgBackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Msg As String
Public StartBackup As String
Public DiscPath As String
Public DiscSize As Integer

Dim Step1 As Boolean
Dim Step2 As Boolean
Dim Step3 As Boolean

Dim Fso As FileSystemObject
Dim rstBackupFile As ADODB.Recordset

Dim BackupFinished As Boolean

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub CmdNext_Click()
        
    '根据不同的步骤,显示不同的控件
    If Step1 Then
        If OptBkToHD.Value = True And Trim(txtPath) = vbNullString Then
            MsgBox "请输入或选择备份路径!", vbInformation
            txtPath.SetFocus
            SendKeys "{Home}+{End}"
            Exit Sub
        End If
        
        '检查备份路径
        If OptBkToHD.Value = True And CheckPath = False Then
            MsgBox "备份路径非法!", vbCritical
            txtPath.SetFocus
            SendKeys "{Home}+{End}"
            Exit Sub
        End If
        
        '取得备份介质信息
        If OptBkToHD.Value = True Then
            If GetDiskInfo = False Then
                Exit Sub
            End If
        Else
            If GetCD_RomInfo = False Then
                Exit Sub
            End If
        End If
      
        '取得要备份的文件信息
        If GetFileInfo = False Then
            Exit Sub
        End If
        
        cmdPrevious.Visible = True
        frmStep1.Visible = False
        frmStep21.Visible = True
        frmStep22.Visible = True
        frmStep3.Visible = False
        Step1 = False
        Step2 = True
        Step3 = False
        
        Exit Sub
    End If
    
    If Step2 Then
    
        '如果剩余空间不足,则退出
        If OptBkToHD.Value = True And CheckSize = False Then
            MsgBox "剩余空间不足,请释放部分磁盘空间以后再试!", vbInformation
            Exit Sub
        End If
        cmdPrevious.Visible = True
        frmStep1.Visible = False
        frmStep21.Visible = False
        frmStep22.Visible = False
        frmStep3.Visible = True
        Step1 = False
        Step2 = False
        Step3 = True
        Exit Sub
        
    End If
    If Step3 Then
        cmdPrevious.Visible = False
        cmdNext.Visible = False

        If OptBkToHD.Value = True Then
            Call BackupToHD
        Else
            Call BackupToCD
        End If
        lblStep3.Caption = "备份结束!" & vbCrLf & "如果以后要刻入光盘," & vbCrLf & "请保持该文件夹现有名称," & vbCrLf & "并刻在光盘的根目录下!"
        cmdCancel.Caption = "结束(&E)"
    End If


End Sub

Private Function CheckPath() As Boolean

Dim i As Integer

    For i = 65 To 90
        If UCase(Left(txtPath.Text, 3)) = Chr(i) & ":\" Then
            On Error GoTo ErrorHandler
    
            If Dir(txtPath, vbDirectory) = vbNullString Then
                MkDir (txtPath)
                CheckPath = True
                Exit Function
            Else
                CheckPath = True
                Exit Function
            End If
        End If
    Next
    
Exit Function
ErrorHandler:
    If Err Then
        CheckPath = False
        Err.Clear
    End If
End Function

Private Function GetFileInfo() As Boolean
'************************************************************************
'功能: 取得要备份的文件数量和全部文件的大小,对于丢失的文件,则写入日志文件
'调用: cmdNext 的 Step1
'************************************************************************
Dim ErrorFile
Dim FileSize As Long
Dim strSQL As String

Set Fso = CreateObject("Scripting.FileSystemObject")

'这儿打开的纪录集要在全模块内使用
Set rstBackupFile = New ADODB.Recordset

If OptBkToHD.Value = True Then
    strSQL = "SELECT * FROM sys_Image WHERE Img_SSSQ BETWEEN '" & txtSSSQHD1.Text & "' AND '" & txtSSSQHD2.Text & "' ORDER BY QYBM"
Else
    strSQL = "SELECT * FROM sys_Image WHERE Img_SSSQ BETWEEN '" & txtSSSQCD1.Text & "' AND '" & txtSSSQCD2.Text & "' ORDER BY QYBM"
End If

rstBackupFile.Open strSQL, conCaseMain, adOpenStatic, adLockOptimistic, adCmdText

With rstBackupFile
    .MoveLast: .MoveFirst
    If .RecordCount > 0 Then
        Do Until .EOF
            If Dir(!Img_Path & !Img_Name) <> vbNullString Then
                FileSize = FileSize + FileLen(!Img_Path & !Img_Name)
            Else
                Set ErrorFile = Fso.OpenTextFile(App.Path & "\ErrorLog.txt", ForAppending, True)
                ErrorFile.WriteLine (!QYBM & " " & !Nsrmc & " " & !Img_Path & !Img_Name & " " & !Img_Case_Name & " " & !Img_Import_Date)
                ErrorFile.Close
            End If
            .MoveNext
        Loop
    Else
        MsgBox "数据库中没有该时期的文书,无需备份!", vbInformation
        GetFileInfo = False
        Exit Function
    End If
End With

lblFileNum.Caption = rstBackupFile.RecordCount
lblFileSize.Caption = Int(FileSize / (1024 ^ 2))
GetFileInfo = True

End Function

Private Function GetDiskInfo() As Boolean
    On Error Resume Next
    
    Dim Fso As FileSystemObject
    Dim ThisDisk As Drive
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set ThisDisk = Fso.GetDrive(Fso.GetDriveName(Left(txtPath.Text, 3)))
    With ThisDisk
        If .DriveType <> 2 Then
            MsgBox "请选择磁盘！", vbInformation
            GetDiskInfo = False
            Exit Function
        End If
        frmStep22.Caption = "备份磁盘信息"
        lblHDInfoL.Caption = "备份磁盘盘符:"
        lblHDFreeSizeL.Caption = "备份磁盘剩余空间:"
        lblDiskInfo.Caption = .DriveLetter
        lblFreeSpace.Caption = vbNullString
        lblFreeSpace.Caption = Int(.AvailableSpace / (1024 ^ 2))
    End With
    GetDiskInfo = True
    
End Function

Private Function GetCD_RomInfo() As Boolean