frmbackup.frm

VB6.0编写的医院影像系统

         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column04 
         DataField       =   "UPLOADED"
         Caption         =   "上传"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column05 
         DataField       =   "SERIAL_ID"
         Caption         =   "序号"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
            ColumnWidth     =   1124.787
         EndProperty
         BeginProperty Column01 
            ColumnWidth     =   2129.953
         EndProperty
         BeginProperty Column02 
            ColumnWidth     =   1665.071
         EndProperty
         BeginProperty Column03 
            ColumnWidth     =   1080
         EndProperty
         BeginProperty Column04 
            Object.Visible         =   0   'False
         EndProperty
         BeginProperty Column05 
            Object.Visible         =   0   'False
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ProgressBar pbrX 
      Height          =   195
      Left            =   120
      TabIndex        =   18
      Top             =   4260
      Width           =   3015
      _ExtentX        =   5318
      _ExtentY        =   344
      _Version        =   393216
      Appearance      =   1
   End
End
Attribute VB_Name = "frmBackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim rs As ADODB.Recordset       '查询备份文件的记录集
Dim bForceStop As Boolean       '强制停止的标志

Public Function ShowBackupRecords()
    
    '-------------------------------------
    '设置记录集过滤的区间, 并显示对应的记录集
    '-------------------------------------
    
    Dim strSQL As String
    Dim strFilter As String
    
    strSQL = "SELECT US_MEDIA.*, US_REPORT.DIAG_DAY, US_REPORT.US_NO FROM US_REPORT INNER JOIN US_MEDIA ON US_REPORT.US_NO = US_MEDIA.US_NO "
    Set rs = OpenRSClient(strSQL, "Data")

    
    Select Case True
        Case optAll.Value
            picPeriod.Visible = False
            strFilter = vbNullString
            
        Case optPeriod.Value
            picPeriod.Visible = True
            strFilter = " DIAG_DAY >= " & MakeSQLDateString(dtpStart.Value) & " AND DIAG_DAY <= " & MakeSQLDateString(dtpEnd.Value)
            
    End Select
    
    rs.Filter = strFilter
    Set dgX.DataSource = rs         '绑定
    dgX.Refresh
    
End Function

Private Sub BackupDir_Click()
    
    '----------------
    '设置备份文件目录
    '----------------
    
    Dim strDir As String
    strDir = BrowseFolder(Me.hwnd, "选择备份图象文件的目录:")
    If strDir <> vbNullString Then
        txtBackupDir.Text = strDir
    End If
    

End Sub

Private Sub cmdExit_Click()
    
    '----------------------------------
    '卸载本窗体
    '----------------------------------
    
    Set rs = Nothing
    Unload Me
    
End Sub

Private Sub cmdOK_Click()
    
    '------------------------------------------
    '开始备份工作
    '------------------------------------------
    
    On Error GoTo ErrHandle:
    
    Dim strFile As String
    Dim strBackupFolder As String           '备份到的目录
    Dim iCount As Long, iPos As Long
    Dim Ret As Integer
    
    With rs
        '检验记录集是否为空
        If .EOF And .BOF Then
            Exit Sub
        End If
        
        '检验服务器路径是否存在
'        If FSO.FolderExists(gstrServerImageDir) = False Then
'            MsgBox "服务器路径不存在! 请检查网络的状态和服务器路径设置是否正确。", vbExclamation + vbOKOnly, "提示"
'            Exit Sub
'        End If
        
        .MoveFirst
        iCount = .RecordCount
        cmdStop.Enabled = True
        
        '获取备份路径并检查其是否存在
        strBackupFolder = txtBackupDir.Text
        If FSO.FolderExists(strBackupFolder) = False Then
            Ret = MsgBox(" 您选择的备份目录不存在, 创建该目录吗?", vbYesNo + vbQuestion, "提示")
            If Ret = vbYes Then
                FSO.CreateFolder strBackupFolder
            Else
                Exit Sub
            End If
        End If
        
        Do While Not .EOF
            '首先尝试找到该文件按照本机->服务器路径的次序查找
            strFile = ChangeFilePath(GetFileName(!FILE_NAME), gstrImageDir)         '获取按照本机路径的图像文件名称
            If FSO.FileExists(strFile) Then GoTo FileExist
            strFile = ChangeFilePath(GetFileName(!FILE_NAME), gstrServerImageDir)   '获取按照服务器路径的图像文件名称
            If FSO.FileExists(strFile) Then GoTo FileExist
            GoTo NextFile
FileExist:
            FSO.CopyFile strFile, ChangeFilePath(GetFileName(!FILE_NAME), strBackupFolder)    '复制文件
NextFile:
            iPos = IIf(iPos >= iCount, iCount, iPos + 1)                            'iPos不能大于iCount,否则会出错
            pbrX.Value = 100 * iPos / iCount
            .MoveNext
            If bForceStop Then
                Exit Sub
            End If
            DoEvents
        Loop
        
    End With
    
    MsgBox "媒体文件备份完成!", vbOKOnly + vbInformation, "提示"
    cmdStop.Enabled = False
    pbrX.Value = 0
    
    Exit Sub
    
ErrHandle:
    ShowError
    Exit Sub
    Resume
    
End Sub

Private Sub cmdRefresh_Click()
    
    ShowBackupRecords
    
End Sub

Private Sub dtpEnd_Click()
    
    ShowBackupRecords
    
End Sub

Private Sub dtpStart_Click()
    
    ShowBackupRecords
    
End Sub

Private Sub Form_Load()
    
    '读取预设值
    IniUS.ReadOptionForm Me
    ShowBackupRecords

End Sub

Private Sub optAll_Click()
    
    ShowBackupRecords

End Sub

Private Sub optPeriod_Click()
    
    ShowBackupRecords

End Sub