dlgdatabasebkopen.frm

排队分诊管理系统源代码！该代码使用VB6开发环境

            Or InStr(txtFileName.Text, ":") > 0 Then
        MsgBox "请正确输入文件名！", vbOKOnly Or vbExclamation, "操作提示"
        Exit Sub
    End If
    
    dlgDatabaseBackup.SetFileName lblPath & txtFileName
    Unload Me
    Exit Sub
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "dlgDatabaseBKOpen"
    m_tagErrInfo.strErrFunc = "cmdOk_Click"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    cmdOk.Enabled = False
End Sub

'***********************************
' 用户双击操作
Private Sub ctlXPFlexGrid_EventCellDbClick(ByVal Row As Long, ByVal Col As Long)
    On Error GoTo ERROR_EXIT
    Dim color As Long
    If Row < 1 Or Row > ctlXPFlexGrid.FilledRowCount Then Exit Sub
    
    ctlXPFlexGrid_EventNonnEditCellClick Row, Col
    If m_lSelRow > 0 And m_lSelRow <= ctlXPFlexGrid.FilledRowCount Then cmdOK_Click
    Exit Sub
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "dlgDatabaseBKOpen"
    m_tagErrInfo.strErrFunc = "ctlXPFlexGrid_EventCellDbClick"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
End Sub

'***********************************
' 用户单击选中操作
Private Sub ctlXPFlexGrid_EventNonnEditCellClick(ByVal Row As Long, ByVal Col As Long)
    On Error GoTo ERROR_EXIT
    Dim color As Long
    Dim strShortFileName As String, strPath As String
    
    cmdOk.Enabled = False
    cmdDelete.Enabled = False
    '恢复原来的选中行的颜色
    If m_lSelRow > 0 And m_lSelRow <= ctlXPFlexGrid.FilledRowCount Then
        If m_lSelRow Mod 2 = 0 Then
            ctlXPFlexGrid.SetRowBackColor m_lSelRow, ctlXPFlexGrid.EvenRowBkColor
        Else
            ctlXPFlexGrid.SetRowBackColor m_lSelRow, ctlXPFlexGrid.OddRowBkColor
        End If
        m_lSelRow = 0
    End If
    
    lblPath.Caption = ""
    txtFileName.Text = ""
    '设置新选中行的颜色
    If Row > 0 And Row <= ctlXPFlexGrid.FilledRowCount Then
        m_lSelRow = Row
        ctlXPFlexGrid.SetRowBackColor Row, &HC0FFC0
        
        '分解并设置完整文件名中的路径和文件名
        If Not FilterFileName(ctlXPFlexGrid.Cell(m_lSelRow, 1), strPath, strShortFileName) Then GoTo ERROR_EXIT
        lblPath.Caption = strPath
        txtFileName.Text = strShortFileName
        If Trim(lblPath.Caption) = "" Or Trim(txtFileName.Text) = "" Then GoTo ERROR_EXIT
        cmdOk.Enabled = True
        cmdDelete.Enabled = True
    End If
    
    Exit Sub
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "dlgDatabaseBKOpen"
    m_tagErrInfo.strErrFunc = "ctlXPFlexGrid_EventNonnEditCellClick"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    cmdOk.Enabled = False
End Sub

'*******************************************************
'初始化 ctlXPFlexGrid 控件各个列的标题
Private Function InitXPFlexGridControl() As Boolean
    On Error GoTo ERROR_EXIT
    Dim fReadOnly As Boolean
    Dim i As Long
    
    fReadOnly = ctlXPFlexGrid.ReadOnly
    ctlXPFlexGrid.ReadOnly = False
    ctlXPFlexGrid.RemoveAllRow
    '设置 ctlXPFlexGrid 控件的的标题
    ctlXPFlexGrid.ColHeadTxts = m_strColumnHeads
    
    ctlXPFlexGrid.ReadOnly = fReadOnly
    InitXPFlexGridControl = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "dlgBaseCity"
    m_tagErrInfo.strErrFunc = "InitXPFlexGridControl"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "初始化 ctlXPFlexGrid 控件各个列的标题失败。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    ctlXPFlexGrid.ReadOnly = True
    InitXPFlexGridControl = False
End Function

'*******************************************************
'显示数据库中已有的备份文件信息
Private Function OpenDB() As Boolean
    On Error GoTo ERROR_EXIT
    Dim rs As New ADODB.Recordset
    Dim cmd As New ADODB.Command
    Dim i As Long
    Dim strRow As String
    
    '查询数据库主表
    cmd.ActiveConnection = dbMyDB
    cmd.CommandText = " SELECT * FROM T_DATABASE_BACKUP WHERE bc_flag = 0 AND bc_SrcdbName = '" _
        & g_MyUserDB.strUserDatabase & "'"
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    
    '文件名 , 备份时间 , 完全/增量备份 , 用户名 , id
    ctlXPFlexGrid.ReadOnly = False
    ctlXPFlexGrid.Visible = False
    ctlXPFlexGrid.RemoveAllRow
    If rs.State <> adStateOpen Then GoTo ERROR_EXIT
    If Not rs.EOF And rs.RecordCount > 0 Then
        rs.MoveFirst
        For i = 0 To rs.RecordCount - 1
            strRow = Trim(rs!bc_filename) & vbTab
            strRow = strRow & Format(rs!bc_BackupTime, "yyyy-mm-dd") & vbTab
            If CLng(rs!bc_full) = 0 Then
                strRow = strRow & "完全" & vbTab
            Else
                strRow = strRow & "增量" & vbTab
            End If
            strRow = strRow & Trim(rs!bc_UserName)
            ctlXPFlexGrid.AddRow strRow
            rs.MoveNext
        Next
    End If
    
    ctlXPFlexGrid.ReadOnly = True
    ctlXPFlexGrid.Visible = True
    'CheckFileNameExist = 0
ERROR_EXIST:
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set cmd = Nothing
    OpenDB = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "dlgDatabaseBackup"
    m_tagErrInfo.strErrFunc = "CheckFileNameExist"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    ctlXPFlexGrid.ReadOnly = True
    ctlXPFlexGrid.Visible = True
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set cmd = Nothing
    OpenDB = False
End Function

Private Sub txtFileName_Change()
    On Error Resume Next
    If Trim(txtFileName.Text) <> "" Then
        cmdOk.Enabled = True
    Else
        cmdOk.Enabled = False
    End If
End Sub

Private Sub cmdQuit_Click()
    On Error Resume Next
    Unload Me
End Sub

'***********************************
' 删除备份文件操作
Private Sub cmdDelete_Click()
    On Error GoTo ERROR_EXIT
    
    If m_lSelRow < 1 Or m_lSelRow > ctlXPFlexGrid.FilledRowCount Then GoTo ERROR_EXIT
    If vbYes <> MsgBox("删除的文件将无法恢复，请确认是否删除！", vbYesNo Or vbExclamation, "警告") Then Exit Sub
    DeleteBackupFile ctlXPFlexGrid.Cell(m_lSelRow, 1)
    
    txtFileName.Text = ""
    cmdDelete.Enabled = False
    If Not OpenDB Then GoTo ERROR_EXIT
    Exit Sub
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "dlgDatabaseBackup"
    m_tagErrInfo.strErrFunc = "CheckFileNameExist"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    txtFileName.Text = ""
    cmdDelete.Enabled = False
End Sub

Private Sub txtFileName_GotFocus()
    txtFileName.BackColor = &H80000018
End Sub

Private Sub txtFileName_LostFocus()
    txtFileName.BackColor = &H80000005
End Sub