📄 frmsystemmaintain.frm
字号:
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 600
TabIndex = 8
Top = 480
Width = 735
End
End
Begin VB.ListBox lstDepartment
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 6780
Left = 240
TabIndex = 4
Top = 480
Width = 5175
End
Begin VB.ListBox lstDepartmentPower
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 6780
Left = 5400
TabIndex = 3
Top = 120
Visible = 0 'False
Width = 1215
End
Begin VB.TextBox txtDepartment
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6240
MaxLength = 10
TabIndex = 2
Top = 1560
Visible = 0 'False
Width = 1695
End
Begin GetData.XPB btnModifyDepartment
Height = 375
Left = 7680
TabIndex = 11
Top = 4200
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "修改"
FontColor = -2147483630
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin GetData.XPB btnDeleteDepartment
Height = 375
Left = 9120
TabIndex = 12
Top = 4200
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "删除"
FontColor = -2147483630
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin GetData.XPB btnAddDepartment
Height = 375
Left = 6240
TabIndex = 13
Top = 4200
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "添加"
FontColor = -2147483630
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin GetData.XPB btnLookUp
Height = 375
Left = 8400
TabIndex = 14
Top = 1560
Visible = 0 'False
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "查找"
FontColor = -2147483630
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label Label10
BackStyle = 0 'Transparent
Caption = "部门名称"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 6240
TabIndex = 18
Top = 2880
Width = 1455
End
Begin VB.Label Label12
BackColor = &H00F1E7DA&
Caption = "部门类别"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 8280
TabIndex = 17
Top = 2880
Visible = 0 'False
Width = 1095
End
Begin VB.Label lblDepartment
BackColor = &H00F1E7DA&
BorderStyle = 1 'Fixed Single
Caption = "部门名称"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 16
Top = 120
Width = 5175
End
Begin VB.Label Label13
BackStyle = 0 'Transparent
Caption = "部门"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 6240
TabIndex = 15
Top = 1200
Visible = 0 'False
Width = 1455
End
End
End
End
Attribute VB_Name = "frmSystemMaintain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'----------------------------------------------------------------------------------------------------
'文件：frmSystemMaintain.frm
'作者：冷家锋
'时间：2008-4-10
'说明：系统维护
'----------------------------------------------------------------------------------------------------
Option Explicit
'部门管理中，管理员分组不显示
Const DEPARTMENT_ADMIN_NAME = "管理员"
Dim curID As Integer
Dim rsUser As New ADODB.Recordset
'权限下拉框, 应该从数据库获取
'0--管理员
'1--科室主任
'2--普通医师
'==用户管理======================================
'用户管理----添加用户
Private Sub btnAdd_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
strSql = "SELECT NAME FROM DOCTOR WHERE NAME = '" + Trim(txtDoctorId.Text) + "'"
If GetRecordNumber(strSql) > 0 Then
MsgBox "该用户已存在!", vbExclamation, "提示"
Exit Sub
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
Dim DPower As Integer
If cmbPower.Text = "管理员" Then
DPower = POWER_ADMIN
End If
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
'刘辉-2008-08-31 20：30 修改：管理员登陆和科室主任登陆
'部门ID 取值位置不同
Dim strInsertSql As String
If USER_POWER = POWER_DEPARTMENT_LEADER Then
strInsertSql = "INSERT INTO Doctor(ID,NAME,UserPassword,Post,UserPower,DEPARTMENTID,IsDelete,DOCTOR_NAME) " _
+ " VALUES(Doctor_SEQUENCE.NEXTVAL,'" + Trim(txtDoctorId.Text) + "','" + Trim(txtUserPassword.Text) + "'," _
+ "'" + Trim(txtDoctorPost.Text) + "','" + CStr(DPower) + "','" _
+ CStr(DEPARTMENT_ID) + "','否','" + Trim(txtDoctorName.Text) + "' ) "
Else
strInsertSql = "INSERT INTO Doctor(ID,NAME,UserPassword,Post,UserPower,DEPARTMENTID,IsDelete,DOCTOR_NAME) " _
+ " VALUES(Doctor_SEQUENCE.NEXTVAL,'" + Trim(txtDoctorId.Text) + "','" + Trim(txtUserPassword.Text) + "'," _
+ "'" + Trim(txtDoctorPost.Text) + "','" + CStr(DPower) + "','" _
+ Trim(cmbDepartments_ID) + "','否','" + Trim(txtDoctorName.Text) + "' ) "
End If
'===事务处理开始====================================================
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 strInsertSql
If Err.Number = 0 Then
myConn.CommitTrans '---提交事務
MsgBox "<用户>添加成功.", vbExclamation, "提示"
Else
myConn.RollbackTransaction
MsgBox "<用户>添加失败!", vbExclamation, "提示"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -