frmsystemmaintain.frm

1、以DLL形式提供医生工作站 2、 根据【检查项目】

    End If
    '===事务处理结束====================================================
    
    Call InitDoctorListBox
    
    txtDoctorId.Text = ""
    txtDoctorName.Text = ""
    txtUserPassword.Text = ""
    txtPasswordAgain.Text = ""
    
    
    txtDoctorPost.Text = ""
    cmbPower.ListIndex = 0
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub
 

Private Sub btnBack_Click(Shifit As Integer)
On Error GoTo ErrHandler
    Unload Me
    frmCheckList.SetFocus
    Exit Sub
ErrHandler:
     MsgBox Err.Description, vbExclamation, "提示"

End Sub

'用户管理----删除用户
Private Sub btnDelete_Click(Shifit As Integer)
On Error GoTo ErrHandler
    If lstUserId.ListCount <= 0 Or Trim(lstUserId.Text) = "" Then
        MsgBox "请选择要删除的用户!", vbExclamation, "提示"
        Exit Sub
    End If
    
    
    
    If MsgBox("您确定要删除吗?", vbYesNo Or vbQuestion, "提示") <> vbYes Then
        Exit Sub
    End If
    
    
    Dim strUpDateSql As String
    strUpDateSql = "DELETE FROM DOCTOR WHERE NAME = '" + lstUserId.Text + "'"
    
    '===事务处理开始====================================================
    Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    myConn.Open modGlobalDbConnect.GetConnectionString
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Sub
    End If
    
    myConn.BeginTrans '开始
    '执行语句
    myConn.Execute strUpDateSql
    If Err.Number = 0 Then
        myConn.CommitTrans '---提交事務
        MsgBox "删除成功.", vbExclamation, "提示"
    Else
        myConn.RollbackTransaction
        MsgBox "删除失败!", vbExclamation, "提示"
    End If
    '===事务处理结束====================================================

    Call InitDoctorListBox
    
    '初始化相关文本框
    txtDoctorId.Text = ""
    txtDoctorName.Text = ""
    txtUserPassword.Text = ""
    txtDoctorPost.Text = ""
    cmbPower.ListIndex = 0
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"

End Sub





'用户管理----修改用户
Private Sub btnModify_Click(Shifit As Integer)
On Error GoTo ErrHandler
'==用户名===========================
    If Trim(txtDoctorId.Text) = "" Then
        MsgBox "请输入要修改的用户名!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If stringCheck(Trim(txtDoctorId.Text)) = False Then
        Exit Sub
    End If
    
    '==用户名===========================
    
    'Dim strSql As String
    'Dim rsPower As New ADODB.Recordset
    'strSql = "SELECT POWER_NUMBER FROM USER_POWER WHERE POWER_NAME = '" _
    '    + Trim(cmbPower.Text) + "'"
    'If myConn.State = adStateClosed Then
    '    myConn.Open modGlobalDbConnect.GetConnectionString
    'End If
        
    'If myConn.State = adStateClosed Then
    '    MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
    '    Exit Sub
    'End If
    
    'If rsPower.State = adStateOpen Then
    '    rsPower.Close
    'End If
    
    'rsPower.Open strSql, myConn
    'If rsPower.RecordCount <> 1 Then
    '    MsgBox "权限错误，请联系管理员。", vbExclamation, "提示"
    '    Exit Sub
    'End If
    
    Dim DPower As Integer
    Dim DepartmentID As Integer
    
    If cmbPower.Text = "科室主任" Then
        DPower = POWER_DEPARTMENT_LEADER
    End If
    
    If cmbPower.Text = "审核医师" Then
        DPower = POWER_AUDITING_DOCT
    End If
    
    If cmbPower.Text = "普通医师" Then
        DPower = POWER_COMMON_USER
    End If
    
    If cmbPower.Text = "管理员" Then
        DPower = POWER_ADMIN
    End If
    
    Dim strSql As String
    strSql = "SELECT NAME FROM DOCTOR WHERE NAME = '" + Trim(txtDoctorId.Text) + "'" _
        + " AND DOCTOR_NAME = '" + Trim(txtDoctorName.Text) + "'" _
        + " AND USERPASSWORD = '" + Trim(txtUserPassword.Text) + "'" _
        + " AND POST = '" + Trim(txtDoctorPost.Text) + "'" _
        + " AND USERPOWER = '" + CStr(DPower) + "'"
        
'    If Not IsNull(rsPower.Fields("POWER_NUMBER")) Then
'        strSql = strSql + " AND USER_POWER = '" + Trim(rsPower.Fields("POWER_NUMBER")) + "'"
'    End If
'

    If Trim(lstUserId.Text) <> Trim(txtDoctorId.Text) Then
        If GetRecordNumber(strSql) > 0 Then
            MsgBox "该用户已存在!", vbExclamation, "提示"
            Exit Sub
        End If
    End If
    '==医生姓名===========================
    If Trim(txtDoctorName.Text) = "" Then
        MsgBox "请输入医生真实姓名!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If stringCheck(Trim(txtDoctorName.Text)) = False Then
        Exit Sub
    End If
    
    '==医生姓名===========================
    
    '==密码===========================
    If Trim(txtUserPassword.Text) = "" Then
        MsgBox "请输入医生密码!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If stringCheck(Trim(txtUserPassword.Text)) = False Then
        Exit Sub
    End If
    
    '==密码===========================
    
    If Trim(txtPasswordAgain.Text) <> Trim(txtUserPassword.Text) Then
        MsgBox "确认密码与密码不符, 请重新输入确认密码!", vbExclamation, "提示"
        Exit Sub
    End If
    
    
    If Len(Trim(txtDoctorPost.Text)) <= 0 Then
        MsgBox "请输入医生职称", vbExclamation, "提示"
    End If
    
    If stringCheck(Trim(txtDoctorPost.Text)) = False Then
        Exit Sub
    End If
    
    
    If MsgBox("您确定要修改吗?", vbYesNo Or vbQuestion, "提示") <> vbYes Then
        Exit Sub
    End If
    
    
    Dim strUpDateSql As String
    
    strUpDateSql = " UPDATE DOCTOR SET NAME ='" + Trim(txtDoctorId.Text) + "',USERPASSWORD =" _
    + "'" + Trim(txtUserPassword.Text) + "', POST = '" + Trim(txtDoctorPost.Text) + "' ,USERPOWER = '" _
    + CStr(DPower) + "', DOCTOR_NAME ='" + Trim(txtDoctorName.Text) + "'" _
    + " WHERE NAME = '" + Trim(lstUserId.Text) + "'"
    
    '===事务处理开始====================================================
    'Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    If myConn.State = adStateClosed Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Sub
    End If
    
    myConn.BeginTrans '开始
    '执行语句
    myConn.Execute strUpDateSql
    If Err.Number = 0 Then
        myConn.CommitTrans '---提交事務
        MsgBox "<用户>修改成功.", vbExclamation, "提示"
    Else
        myConn.RollbackTransaction
        MsgBox "<用户>修改失败!", vbExclamation, "提示"
    End If
    '===事务处理结束====================================================
    
    Call InitDoctorListBox
    txtDoctorId.Text = ""
    txtDoctorName.Text = ""
    txtUserPassword.Text = ""
    txtPasswordAgain.Text = ""
    
    txtDoctorPost.Text = ""
    
    'cmbPower.ListIndex = 0
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation, "提示"
End Sub


'===密码管理==========================================
'密码管理----确定 按钮事件
Private Sub btnOk_Click(Shifit As Integer)
    If Len(Trim(txtOldPassword.Text)) <= 0 Then
        MsgBox "请输入旧密码!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If stringCheck(Trim(txtOldPassword.Text)) = False Then
        Exit Sub
    End If
    
    If Len(Trim(txtNewPassword.Text)) <= 0 Then
        MsgBox "请输入新密码!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If stringCheck(Trim(txtNewPassword.Text)) = False Then
        Exit Sub
    End If

    If Len(Trim(txtReNewPassword.Text)) <= 0 Then
        MsgBox "请输入确认密码!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If stringCheck(Trim(txtNewPassword.Text)) = False Then
        Exit Sub
    End If
    
    If InStr(txtReNewPassword.Text, " ") > 0 Or InStr(txtNewPassword.Text, " ") > 0 Then
        MsgBox "密码中不能含有空格, 请重新输入新密码!", vbExclamation, "提示"
        Exit Sub
    End If
    
    If Trim(txtNewPassword.Text) <> Trim(txtReNewPassword.Text) Then
        MsgBox "新密码和确认密码不一致!", vbExclamation, "提示"
        Exit Sub
    End If
    
    On Error GoTo ErrHandler
    Dim strSql As String
    strSql = "SELECT UserPassword FROM Doctor WHERE ID = '" + CStr(USER_ID) + "'"


    
    Dim myConn As New ADODB.Connection
    myConn.CursorLocation = adUseClient
    
    If rsUser.State = adStateOpen Then
        rsUser.Close
    End If
    If myConn.State = 0 Then
        myConn.Open modGlobalDbConnect.GetConnectionString
    End If
    
    If myConn.State = adStateClosed Then
        MsgBox "数据库连接错误，请查看网络状态！", vbExclamation, "提示"
        Exit Sub
    End If
    
    rsUser.Open strSql, myConn
    If rsUser.RecordCount <> 1 Then
        MsgBox "用户信息存在错误, 请与系统管理员联系!", vbExclamation, "提示"
        Exit Sub
    End If
    If Trim(txtOldPassword.Text) <> Trim(rsUser.Fields("UserPassword")) Then
        MsgBox "密码输入错误, 请重新输入", vbExclamation, "提示"
        Exit Sub
    End If
    
    strSql = "UPDATE Doctor SET UserPassword = '" + Trim(txtNewPassword.Text) _
        + "' WHERE ID ='" + CStr(USER_ID) + "'"
        
    '===事务处理开始====================================================
    myConn.BeginTrans '开始
    '执行语句
    myConn.Execute strSql
    If Err.Number = 0 Then
        myConn.CommitTrans '---提交事務
        MsgBox "密码修改成功.", vbExclamation, "提示"
    Else
        myConn.RollbackTransaction
        MsgBox "密码修改失败!", vbExclamation, "提示"
    End If
    '===事务处理结束====================================================
    
    txtOldPassword.Text = ""
    txtNewPassword.Text = ""
    txtReNewPassword.Text = ""
    
    
    Exit Sub
ErrHandler:
    MsgBox "获取用户信息失败, 原因:" + Err.Description, vbExclamation, "提示"
    
End Sub
'===密码管理==========================================


'用户管理----查找用户
Private Sub btnSearch_Click(Shifit As Integer)
On Error GoTo ErrHandler
'    If Trim(txtSelectDoctorName.Text) = "" Then
'        MsgBox "请输入要查找的医生姓名!", vbExclamation, "提示"
'        Exit Sub
'    End If
    
    If stringCheck(Trim(txtSelectDoctorName.Text)) = False Then
        Exit Sub
    End If
    
    Dim strSql As String
   
    strSql = "SELECT  DISTINCT Doctor.Name as Doctor_Name " _
        + " FROM Doctor , Department WHERE Doctor.DepartmentID = Department.ID "
    
    If Len(Trim(txtSelectDoctorName.Text)) > 0 Then
        strSql = strSql + " and Doctor.Name LIKE '%" + Trim(txtSelectDoctorName.Text) + "%'" _
        + " AND DOCTOR.USERPOWER <> '" + CStr(USER_POWER) + "'"