?? frmimgbackup.frm
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -