第1页 / 共139页
第2页 / 共139页
第3页 / 共139页
第4页 / 共139页
第5页 / 共139页
第6页 / 共139页
第7页 / 共139页
第8页 / 共139页
医院信息管理系统VB6源程序.doc
医院信息管理系统 VB6 源程序
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form frmlogin
1
"医院信息管理系统用户登录"
1650
45
330
4110
= &H00004000&
=
'Fixed Single
=
=
=
=
=
= &H00404040&
= &H00404040&
=
=
=
=
=
=
=
BackColor
BorderStyle
Caption
ClientHeight
ClientLeft
ClientTop
ClientWidth
FillColor
ForeColor
"frmlogin.frx":0000
Icon
"Form1"
LinkTopic
0
MaxButton
0
MinButton
"frmlogin.frx":030A
Picture
1650
ScaleHeight
4110
ScaleWidth
StartUpPosition =
'屏幕中心
Begin MSAdodcLib.Adodc Adodc1
'False
'False
2
=
0
'False
330
2760
0
1200
2117
582
0
3
-1
15
30
3
3
=
8
=
=
=
=
=
=
=
=
=
Height
Left
Top
Visible
Width
_ExtentX
_ExtentY
ConnectMode
CursorLocation =
IsolationLevel =
ConnectionTimeout=
CommandTimeout =
CursorType
LockType
CommandType
=
CursorOptions
=
CacheSize
=
MaxRecords
=
BOFAction
=
EOFAction
ConnectStringType=
=
Appearance
=
BackColor
ForeColor
=
Orientation
=
=
Enabled
=
Connect
=
OLEDBString
OLEDBFile
=
DataSourceName =
0
50
0
0
0
1
1
-2147483643
-2147483640
0
-1
""
""
""
""
OtherAttributes =
UserName
Password
RecordSource
Caption
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
""
""
""
"Adodc1"
""
=
=
=
=
Name
Size
Charset
Weight
Underline
Italic
Strikethrough
=
"宋体"
=
=
=
=
=
=
9
134
400
0
0
0
'False
'False
'False
EndProperty
_Version
End
Begin VB.TextBox Text1
=
393216
End
Begin VB.TextBox Text2
BackColor
ForeColor
Height
Left
MaxLength
TabIndex
Top
Width
BackColor
ForeColor
Height
IMEMode
Left
MaxLength
PasswordChar
TabIndex
Top
Width
Caption
Height
Left
TabIndex
Top
Width
Caption
Height
Left
TabIndex
Top
Width
= &H00FFFFFF&
= &H000000FF&
=
=
=
=
=
=
270
1185
20
0
250
2400
= &H00FFFFFF&
= &H000000FF&
=
=
'DISABLE
270
3
1185
20
"*"
1
650
2400
"确定"
320
945
2
1150
800
"取消"
320
2505
3
1150
800
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
End
Begin VB.CommandButton Command1
End
Begin VB.CommandButton Command2
-1
'True
End
Begin VB.Label Label1
=
= &H00004000&
=
'Transparent
=
= &H00000000&
=
=
=
=
=
AutoSize
BackColor
BackStyle
Caption
ForeColor
Height
Left
TabIndex
Top
Width
180
480
5
310
540
0
"用户名"
-1
'True
End
Begin VB.Label Label2
=
= &H00004000&
=
'Transparent
=
= &H00000000&
=
=
=
=
=
AutoSize
BackColor
BackStyle
Caption
ForeColor
Height
Left
TabIndex
Top
Width
180
480
4
710
540
0
"密 码"
End
End
Attribute VB_Name = "frmlogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public userdwname As String
Public username As String
Public userright As String
Public conn As String
Private Sub Command1_Click()
Dim password As String
Dim respond As String
username = Text1.Text
password = Text2.Text
On Error GoTo err1
Adodc1.ConnectionString = conn
Adodc1.RecordSource = "select * from usertab where 用户名=" & "'" & username &
"'" & " and " & "密码=" & "'" & password & "'"
Adodc1.Refresh
If Adodc1.Recordset.AbsolutePosition = adPosUnknown Then
respond = MsgBox("用户名或密码错误，请重新输入！", vbOKOnly, "警告")
If respond <> vbOKOnly Then
Text1.SetFocus
Text1.Text = ""
Text2.Text = ""
username = ""
password = ""
End If
Else
userright = Adodc1.Recordset.Fields("权限")
Unload frmlogin
frmmain.Show
End If
Exit Sub
err1:
MsgBox "系统配置错误！无法与服务器连接！"
userright = "0"
Unload Me
frmsysset.Show
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path &
"\his.mdb;Persist Security Info=False"
'conn = Frmstart.pconn
End Sub
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.MDIForm frmmain
BackColor
Caption
ClientHeight
ClientLeft
ClientTop
ClientWidth
Icon
LinkTopic
Picture
WindowState
Begin MSAdodcLib.Adodc Adodc1
= &H00FFFFFF&
=
=
=
=
=
=
=
=
=
"医院门诊收费管理"
8010
165
630
11880
"frmmain.frx":0000
"MDIForm1"
"frmmain.frx":030A
2
'Maximized
'Align Top
1
375
0
0
Align
Height
Left
Top
Visible
Width
_ExtentX
_ExtentY
ConnectMode
CursorLocation =
=
=
=
=
=
=
=
=
=
0
'False
11880
20955
661
0
3
8
=
-1
3
3
=
=
15
30
0
50
0
0
0
1
1
-2147483643
-2147483640
IsolationLevel =
ConnectionTimeout=
CommandTimeout =
CursorType
LockType
CommandType
=
CursorOptions
=
CacheSize
=
MaxRecords
=
BOFAction
EOFAction
=
ConnectStringType=
Appearance
=
=
BackColor
ForeColor
=
=
Orientation
=
Enabled
=
Connect
=
OLEDBString
=
OLEDBFile
DataSourceName =
OtherAttributes =
UserName
Password
RecordSource
Caption
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
""
""
""
"Adodc1"
""
=
=
=
=
-1
""
""
""
""
0
Name
Size
Charset
Weight
Underline
Italic
Strikethrough
=
"宋体"
=
=
=
=
=
=
9
134
400
0
0
0
'False
'False
'False
EndProperty
_Version
=
393216
End
Begin MSComctlLib.StatusBar StatusBar1
'Align Bottom
Align
Height
Left
TabIndex
Top
Width
_ExtentX
_ExtentY
_Version
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
2
300
0
0
7710
11880
20955
529
393216
=
=
=
=
=
=
=
=
=
3
=
NumPanels
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
=
2
AutoSize
Object.Width
=
1
=
15266
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
=
2
AutoSize
EndProperty
EndProperty
End
Begin VB.Menu menu1
=
Caption
Begin VB.Menu menu11
=
=
Caption
Shortcut
"收费管理&(N)"
"费用登记&(I)"
^I
"-"
"费用查询&(Q)"
^Q
"-"
"交班结算&(G)"
{F12}
"-"
"退出&(E)"
^E
End
Begin VB.Menu line11
=
Caption
End
Begin VB.Menu menu12
=
=
Caption
Shortcut
End
Begin VB.Menu line12
=
Caption
End
Begin VB.Menu menu14
=
=
Caption
Shortcut
End
Begin VB.Menu line13
=
Caption
End
Begin VB.Menu menu13
=
=
Caption
Shortcut
End
End
Begin VB.Menu menu2
=
Caption
Begin VB.Menu menu21
=
=
Caption
Shortcut
End
Begin VB.Menu line21
=
Caption
End
Begin VB.Menu menu22
=
=
Caption
Shortcut
End
Begin VB.Menu menu23
=
=
Caption
Shortcut
End
"数据维护&(R)"
"清理数据库&(C)"
^C
"-"
"更改密码&(P)"
^P
"系统设置&(S)"
^S
"窗口&(W)"
"层叠&(C)"
"水平平铺&(H)"
"垂直平铺&(V)"
"-"
"排列图标&(A)"
"帮助&(H)"
End
Begin VB.Menu menu3
=
Caption
Begin VB.Menu menu31
=
Caption
End
Begin VB.Menu menu32
=
Caption
End
Begin VB.Menu menu33
=
Caption
End
Begin VB.Menu line31
=
Caption
End
Begin VB.Menu menu34
=
Caption
End
End
Begin VB.Menu menu4
=
Caption
Begin VB.Menu menu41
=
=
Caption
Shortcut
End
Begin VB.Menu line41
=
Caption
End
Begin VB.Menu menu42
=
Caption
End
End
"帮助主题&(L)"
{F1}
"-"
"关于门诊收费管理&(A)..."
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub MDIForm_Load()
Dim uname As String
Dim quan As String
quan = frmlogin.userright
If quan = "0" Then
quan = "【超级用户】"
Else
quan = "【普通用户】"
End If
uname = frmlogin.username
StatusBar1.Panels(1).Text = "当前系统操作人员：" & uname & quan
StatusBar1.Panels(3).Text = "当前系统日期：" & Year(Now()) & "年" & Month(Now()) & "月"
& Day(Now()) & "日"
StatusBar1.Panels(2) = "目前没有窗口被激活"
End Sub
Private Sub menu11_Click()
frmsf.Show
End Sub
Private Sub menu12_Click()
frmquery.Show
End Sub
Private Sub menu13_Click()
End
End Sub
Private Sub menu14_Click()
frmjb.Show
End Sub
Private Sub menu21_Click()
Dim respond As String
If frmlogin.userright = "0" Then
respond = MsgBox("此操作将永久删除门诊收费室所有记录！是否继续？", 4, "特别警告")
If respond = vbYes Then
Adodc1.ConnectionString = frmlogin.conn
Adodc1.RecordSource = "select * from mzsf order by ID"
Adodc1.Refresh
Do While Not Adodc1.Recordset.EOF
Adodc1.Recordset.Delete
Adodc1.Recordset.MoveNext
Adodc1.Recordset.UpdateBatch
Loop
End If
Else
MsgBox "只能超级用户才能执行此操作！"
End If
End Sub
Private Sub menu22_Click()
chpwd.Show
End Sub
Private Sub menu23_Click()
If frmlogin.userright = "0" Then
frmsysset.Show
Else
MsgBox "只能超级用户才能执行此操作！"
End If
End Sub
Private Sub menu31_Click()
Me.Arrange vbCascade
End Sub
Private Sub menu32_Click()
相关推荐
2023年江西萍乡中考道德与法治真题及答案.doc
2012年重庆南川中考生物真题及答案.doc
2013年江西师范大学地理学综合及文艺理论基础考研真题.doc
2020年四川甘孜小升初语文真题及答案I卷.doc
2020年注册岩土工程师专业基础考试真题及答案.doc
2023-2024学年福建省厦门市九年级上学期数学月考试题及答案.doc
2021-2022学年辽宁省沈阳市大东区九年级上学期语文期末试题及答案.doc
2022-2023学年北京东城区初三第一学期物理期末试卷及答案.doc
2018上半年江西教师资格初中地理学科知识与教学能力真题及答案.doc
2012年河北国家公务员申论考试真题及答案-省级.doc
2020-2021学年江苏省扬州市江都区邵樊片九年级上学期数学第一次质量检测试题及答案.doc
2022下半年黑龙江教师资格证中学综合素质真题及答案.doc
