毕业设计开题报告

（ 2012 届大学本科）

题 目： 学 院： 专 业： 班 级：

姓 名： 学 号： 主指导教师：20xx年 7 月 31 日

教务处印制

一、引言

1．课题背景

客户价值不仅仅是客户当前的盈利能力，也包括企业将从客户一生中获得的贡献的折现净值[1]。客户是酒店一切有形无形服务产品的直接购买者，其在消费过程中所反映、反馈的一切意见与建议，通常能准确地反映出客户的消费需求，市场的潜在动向及酒店的服务品质等，故对此应予以重视，并应通过内部有序的渠道进行分流整合，以便酒店及时改进完善自身的服务工作[2]。

2． 课题意义

随着互联网覆盖面的扩大，信息的飞速传播，企业面对日益激烈的市场竞争[3]，传统的酒店客户意见单（卡）箱，已经不能满足客户的需求，为了适应网络的发展和商务网站的需要，酒店客户意见管理系统营运而生，它很好的为客户和企业之间建立了沟通桥梁，同时也降低了双方沟通的费用，所以酒店客户意见管理系统将具有广阔的市场空间和发展潜力。

3． 课题目的

酒店客户意见管理系统以业务为基础，客户为核心，实现市场、销售、服务协同工作的管理平台。系统主要任务是对企业客户的意见记录进行管理，并将意见记录分配给工程师进行处理，对接受服务调查的客户进行调查信息的管理。主要功能：客户信息管理、客户记录管理、记录分配管理、工作记录管理、服务调查管理等。

4． 国内外现状

目前酒店采用的客户意见系统主要是：意见箱和投诉电话。

1、客户意见单（卡）箱：在酒店管理的各营业部门的营业位置，如中餐、客房等摆设消费意见卡和箱，供客户填写、反映消费的意见与建议，意见卡和箱可由部门人员收集上交酒店管理层，亦可由客户自行投放设于各处的意见箱内；

2、客户投诉直线电话：在摆设于各部的消费意见卡上设有一内部分机号（如总机、或总经理室秘书处）为宾客投诉热线，以供客户投诉。

这两种方式所提供的应用服务局限性很大，不能达到企业信息化建设的需求。

酒店客户意见管理系统是在客户与企业之间，架设了更有效的沟通渠道，构建了交互式的沟通方式。借助这一方式，企业可以通过IP地址，随时、准确地了解每一位客户的居住区域及其各种有关信息。运用数据库管理、Internet等信息系统和信息技术，企业不仅能够及时、迅速、大量地收集客户信息，并及时传递给客户控制中心加以处理，而且可以实现对 1

客户信息的更好保护和利用[4]。

二、设计课题所要实现的主要功能

系统功能是在实际开发设计过程中经过调研、分析用户需求，和用户一起共同确定下来的，是系统为满足用户需求所应完成的功能

归纳如下： 客户意见管理所需要实现的功能可以细分为几个模块：客户信息管理、客户意见管理、记录分配管理、工作记录管理和服务调查管理。

1、客户信息管理

该模块负责对客户意见管理的使用员工进行管理。主要功能包括添加、删除、修改和查找员工信息。

2、客户意见管理

该模块负责对客户意见信息进行维护，包括对客户意见记录的基本信息（如客户名称、意见描述、严重级别、是否服务调查等）进行检索、录入和修改。

3、记录分配管理

该模块负责对客户意见记录进行任务分配管理。将客户意见记录分配给负责工程师，并对分配信息（如负责工程师、处理意见、处理时间等）进行检索、录入和修改。

记录分配管理分为3个子模块：待分配记录管理，已分配记录管理，已解决记录管理。

4、工作记录管理

该模块负责对工程师解决意见过程中的工作记录进行管理，包括对工作记录信息进行检索、录入和修改等。

工作记录管理分为两个子模块：待解决记录管理和已解决记录管理。

5、服务调查管理

该模块负责对服务情况的调查管理，并对服务调查信息（如解决方式、处理地点、遗留意见等）进行检索、录入和修改。 [11] 。经过我们的调研，将系统需要完成的功能

三、设计课题的开发要求

1．酒店意见管理系统web界面开发

2．管理系统功能模块的开发

3．系统用户权限的逻辑设计

4．系统后台数据库连接

四、设计课题所用主要技术

1．系统分析与设计

2

2．数据库设计与开发

3．数据库管理系统应用（SQL server） 4．ASP.NET和C#技术开发

五、设计课题开发相关开发环境的配备

1. Windows Server 2003服务器提供系统服务 2. ASP.net技术服务 3. SQL server数据库服务

六、毕业设计论文进度计划

七、参考文献

[1] 弗列德.威尔斯马.客户联盟[M].机械工业出版社，2000.1.

[2] 韦兰(Wayland.R.E),科尔(Cole.P.E) .走进客户的心[M].北京：经济日报出版社，1998.2.

[3] 马丁.特鲁特，保罗.唐波拉.与客户亲密接触：通过客户关系管理实现品牌价值最大化[M]. 上海交通大学出版社，2002.10.

[4] 凌云峰，万晓冬.基于ERP的CRM开发模式探讨[J].计算机应用与软件，2004,8(16)：12-15．

[5] 弗罗伊.唯一干扰人的是顾客：以顾客关系网络替代营销[M].北京: 经济管理出版社，2000.1.

[6] 金雪云.ASP.NET 简明教程[M].清华大学出版社,2006.1.

[7] Simon Robinson,K.Scott Allen等. C#高级编程[M].北京:清华大学出版社,2002.3. [8] 郑阿奇.SQL Server实用教程[M].北京:电子工业出版社,2002.8.

[9] 李晓喆，张晓辉，李祥胜.SQL Server 2000管理及应用系统开发[M].人民邮电出版社，2002.1.

3

[10] Tom Archer. C#技术内幕[M].北京:清华大学出版社,2002.1.

[11] 周存杰.Visual C#.NET网络核心编程[M].清华大学出版社, 2002.1.

[12] Sophie D’Amours,Benoit Montreuil, Pierre Lanfranc: The impact of information sharing[J].Int.J.Production Economics,1999(58)：63–79.

[13] 郭常圳，李云锦.ASP.NET网络应用开发例学与实践[M].清华大学出版社 2006.1.

[14] 宋昆，李严等.SQL Server数据库开发实例解析[M].北京：机械工业出版社，2006.1.

[15] 赵松涛．SQL SERVER 2000应用及实例研究[J]. 北京:清华大学学

报,2002,14(156):28-98

[16] 孙印杰，杨滔，吕书琴.ASP.NET+SQL Server动态网站设计实例精解[M].北京:电子工业出版,2004.9.

八、指导教师意见

4

 

第二篇：娱乐休闲型酒店管理信息系统--开题报告

0582计算机信息管理毕业设计

娱乐休闲型酒店管理信息系统

开题报告

0582/23 周天才

指导老师：徐莉

一、

综述

计算机在旅游餐饮和娱乐休闲行业的应用现已十分普遍，但相应的管理信息软件却不象财会软件那样成熟、稳定和规范，为大众所知晓。在这很大程度上是由于使用主体日新月异的经营方式和多变的运行模式所造成的。无论是业内人士还是计算机系统开发者都难免被这类行业发展变化之快所困扰。在计算机业务管理信息系统的建设和选择上目的不太明确，盲目照搬国外的大型软件，花钱不少，但效果不好，临时拼凑一些软件模块勉强使用，不足之处用手工作业来祢补。总之都没有充分发挥出高新技术在降低运营成本，提高管理水平和综合经济效益中的积极作用。实际上，该行业面向市场在竞争中不断变化的特点，已经决定了其管理信息系统软件是一个与管理对象密切相关的有机组成部分，需要经过认真的和长期的调查分析，并以次为基础去定制、去磨合，在设计和开发的进程中寻找规律，以逐步完善。因此，其系统开发建设本身所遇到的问题和解决问题的办法，也体现了一个比较复杂的管理信息系统的开发特点。

二 、研究方向

随着改革开放的步伐，人民生活水平得到了极大的提高，人们对服务业的需求也越来越高。特别是对娱乐休闲型酒店的娱乐方式要求很高。为此，娱乐休闲型酒店也采取了很多方式进行改革，加快步伐，与西方的娱乐休闲型酒店接轨。

进入二十一世纪，信息管理系统在各行各业取得了突飞猛进的发展，如银行﹑车辆运输﹑学校﹑酒店等等。开发娱乐休闲型酒店的目的是打破以前的管理方式，实现全自动化办公管理方式。

在系统开发的全过程始终要采取用户至上的观点，一切从用户利益考虑，在加强调查研究和系统分析的基础上，通过分步骤的不断反馈的讨论式方法确定出新系统的最佳方按。各阶段可在局部上使用结构化、模块化的方法严格按照有效阶段进行开发，具体手段上尽量采用面向对象的开发形式，使形成的应用软件模块具有很强的独立性、适应性和扩展性。

一、 实现方法及预期目标

在针对实际系统进行关系定义和逻辑设计过程中，我们发现采用移植的办法虽然在模块设计阶段进展较快，但后来就会被两类不同运行模式中的复杂关系所纠缠，而影响了开发进度，甚至会造成大面积返工。相反，按照娱乐休闲型酒店的实际业务流程重新进行系统设计，到开发后期，就会发现这种淡化了住宿功能，而以洗浴服务为主线的接待和消费方式还有一些规律性。

系统的设计开发过程采用了快速原形法，结构化方法和讨论法相结合的混合方式，鉴于这类新酒店的应用需求是不规范的和分批提出的，系统分析的深度和广度只能在开发过程- - 1 -

0582计算机信息管理毕业设计

中逐步增加和完善，所以在开发初期一般无法完整的确定其总体设计方按。为此，我们从用户对应用系统的粗略描述开始，现在计算机上搭建起一个简单的应用模型，并以次模型为基准，根据用户的意见和要求对系统进一步细化，通过不断的建模，演示，交流和讨论，使系统一步步地接近实际。在开发后期，开发人员同用户已经有了充分的沟通，因此在一些后台模块的开发上也遵循了结构化的生命周期法。在程序设计方式上主要是利用了一些高效率的面向对象的开发工具，通过这些工具对快速原形法和讨论法实施有效的支撑，进一步提高了系统的易扩展性和灵活性。

本系统采用网络数据库程序的开发方法。前端开发工具采用Microsoft公司的专用数据库应用程序开发工具（VISIUAL BASIC 6.0）版本。后端的数据库采用微软公司的SQL Server2000版本。

本系统开发的重点有：

1.数据库的开发

2.程序的开发.其中程序的开发是本系统开发的难点，弄清管理信息系统的功能模块，了解功能模块之间的关联和次序是关键。

3.通过各程序的模块直接控制数据库的信息，最终实现娱乐休闲型酒店管理系统的应用目标

四、系统的开发进度具体安排

由于时间有限，具体工作安排如下：

第13周完成课题调研、开题报告及系统开发；

第14周完成总体方案设计、数据库设计；

第15周完成模块设计、输入输出设计；

第16周完成具体实现：1.数据库开发2.在sqlserver中创建数据库的连接3.程序的开发 第17周完成系统各模块的测试、修改及验收系统，同时上交毕业论文。

五、参考文献

《信息系统开发教程 第三辑》 出版社：清华大学出版社 作者：张基温 《信息系统开发教程 第四辑》 出版社：清华大学出版社 作者：张基温 <〈SQL Server7.0设计实务 〉〉 出版社：人民邮电出版社 作者：施威铭 〈〈VB程序设计教程 第二版〉〉 出版社：电子工业出版社 作者：刘瑞新

指导老师 监督老师

(签署意见并签字） （签署意见并签字）

领导小组审查意见： 审查人签字： 年 月 日

- - 2 -

0582计算机信息管理毕业设计

程序设计

打开VB程序，出现VB主界面，单击窗体下的frmlogin控件，单击运行，出现一个登录界面，请输入用户名称和用户密码，双击确定按钮，代码如下：

Option Explicit

Public LoginCount As Integer '定义此变量的目的是为了判断登录的次数

Private Sub CmdOk_Click()

If LoginCount < 3 Then

With DbCommand

Set .ActiveConnection = DbConn

.CommandType = adCmdText

.CommandText = "Select username,userpassword from hotellogin where username='" + txtUersName.Text + "'"

Set DbTempSet = .Execute

End With

If DbTempSet.EOF And DbTempSet.BOF Then

MsgBox "用户不存在，请重新输入用户ID", vbOKOnly

frmLogin.txtUersName.Text = ""

frmLogin.txtUersName.SetFocus

Else

If RTrim(LTrim(DbTempSet.Fields(1).Value)) <> txtPassword.Text Then

MsgBox "输入的该用户的密码错误，请重新输入！", vbOKOnly

frmLogin.txtPassword.Text = ""

frmLogin.txtPassword.SetFocus

LoginCount = LoginCount + 1

Else

UserId = txtUersName.Text

LoginSucceeded = True

Unload Me

End If

End If

Else

If Not AppRun Then

LoginSucceeded = False

Unload Me

Else

Unload frmMain

Unload Me

End If

End If

End Sub

Private Sub cmdPasswork_Click()

- - 3 -

0582计算机信息管理毕业设计

If Not AppRun Then

LoginSucceeded = False

Unload Me

Else

Unload frmMain

Unload Me

End

End If

End Sub

Private Sub Form_Activate()

frmLogin.txtUersName.SetFocus

frmLogin.txtUersName.Text = ""

frmLogin.txtPassword.Text = ""

End Sub

Private Sub Form_Load()

On Error GoTo ProErr:

frmLogin.Left = 3900 '调整窗体的位置（靠左面的距离）

frmLogin.Top = 3200 '调整窗体的位置(靠顶部的距离)

Call get_text

With DbConn

If .State <> adStateClosed Then

.Close

End If

End With

If DbConn Is Nothing Then

End If

DbConn.Open

Exit Sub

ProErr:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

'************************************************************************ '*此段程序的目的是当按回车键的时候光标自动跳入txtpassword.text中 *

'************************************************************************ Private Sub txtUersName_Keydown(KeyCode As Integer, Shift As Integer)

If KeyCode = 13 Then

frmLogin.txtPassword.SetFocus

End If

End Sub

'****************************************************************************** '*此段程序目的是当按回车键的时候光标自动跳入到确定按扭上准备开始验证输入的用户名称和用户密码*

'****************************************************************************** private Sub txtPassword_KeyDown(KeyCode As Integer, Shift As Integer)

- - 4 -

0582计算机信息管理毕业设计

If KeyCode = 13 Then

cmdOK.SetFocus

End If

End Sub

进入主界面，主界面代码如下：

Private Sub AboutSystem_Click()

FrmAboutSys.Show vbModal

End Sub Private Sub AboutSystem_Click()

FrmAboutSys.Show vbModal

End Sub

Private Sub backrestore_Click()

FrmBakRes.Show vbModal

End Sub

Private Sub clearbkg_Click()

Set CTRLMachineLV.Picture = Nothing

End Sub

Private Sub ExitSystem_Click()

FrmExitSys.Show vbModal

Exit Sub

End Sub

Private Sub Form_Load()

frmMain.Top = 0

frmMain.Left = 0

End Sub

Private Sub roomcondition_Click()

FrmDayFlux.Show vbModal

End Sub

Private Sub roomdengjiruzhu_Click()

frmdengji.Show vbModal

End Sub

Private Sub roomtypeprice_Click()

frmroomprice.Show vbModal

End Sub

Private Sub setbkg_Click()

On Error GoTo ErrHandler

With BmpOpenDlg

.CancelError = True

.Flags = cdlOFNHideReadOnly

.Filter = "所有图片"

.FilterIndex = 0

End With

BmpOpenDlg.ShowOpen

CTRLMachineLV.Picture = LoadPicture(BmpOpenDlg.FileName) - - 5 -

0582计算机信息管理毕业设计

Exit Sub

ErrHandler:

If Err.Number <> 32755 Then

MsgBox Err.Description, vbOKOnly, App.Title

End If

End Sub

Private Sub setpassword_Click()

frmChangepass.Show vbModal

End Sub

Private Sub syslogin_Click()

frmLogin.Show vbModal

End Sub

Private Sub Timer1_Timer()

Dim StrWeekDay As String

On Error GoTo Errp:

Select Case Weekday(Now())

Case 1

StrWeekDay = "星期日"

Case 2

StrWeekDay = "星期一"

Case 3

StrWeekDay = "星期二"

Case 4

StrWeekDay = "星期三"

Case 5

StrWeekDay = "星期四"

Case 6

StrWeekDay = "星期五"

Case 7

StrWeekDay = "星期六"

End Select

StBar.Panels.Item(1).Text = "当前用户：" & CStr(UserId)

StBar.Panels.Item(2).Text = "欢迎您使用娱乐休闲型酒店管理信息系统"

StBar.Panels.Item(3).Text = CStr(Year(Now())) & "年" & CStr(Month(Now())) & "月" & CStr(Day(Now())) & "日" & "(" & StrWeekDay & ")" & " " & Time

Exit Sub

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) '处理ToolBar功能

On Error GoTo Errp

Select Case Button.Key

- - 6 -

0582计算机信息管理毕业设计

Case Is = "yhdl"

frmLogin.Show vbModal

Case Is = "yhgl"

frmUserMan.Show vbModal

Case Is = "yhmm"

frmChangepass.Show vbModal

Case Is = "shezhiback"

Call setbkg_Click

Case Is = "morenback"

Call clearbkg_Click

Case Is = "backuprestor"

FrmBakRes.Show vbModal

Case Is = "kefangdj"

frmdengji.Show vbModal

Case Is = "kefangchaxun"

FrmDayFlux.Show vbModal

Case Is = "fangtypechaxun"

frmroomprice.Show vbModal

Case Is = "xiaofeimingxi"

frmcostitem.Show vbModal

Case Is = "aboutsystem"

FrmAboutSys.Show vbModal

Case Is = "quitsystem"

FrmExitSys.Show vbModal

End Select

Exit Sub

Errp:

MsgBox Err.Description, vbOKOnly, "系统提示"

End Sub

Private Sub usermanage_Click()

frmUserMan.Show vbModal

End Sub

Private Sub xiaofeiquery_Click()

frmcostitem.Show vbModal

End Sub

单击系统管理的“密码管理”目的是对您的密码进行保护，移防您的原始密码被别人知道后，可以更改，重新用一个新的密码来加以保护。代码如下：

Private Sub cmdCancel_Click()

Unload Me

End Sub

Private Sub CmdOk_Click()

On Error GoTo Errp:

- - 7 -

0582计算机信息管理毕业设计

With DbCommand

.CommandType = adCmdText

.CommandText = "Select userPassword from hotellogin where username='" + UserId + "'" Set DbTempSet = .Execute

End With

If Text1.Text = LTrim(RTrim(DbTempSet.Fields(0).Value)) Then

If Text2.Text = Text3.Text Then

With DbCommand

.CommandText = "Update hotellogin set userpassword='" + Text2.Text + "' where username='" + UserId + "'"

.Execute

End With

Unload Me

Else

MsgBox "你两次输入的新密码不一样，请重新输入", vbOKOnly, "系统提示" Text2.SetFocus

Text2.Text = ""

Text3.Text = ""

End If

Else

MsgBox "你输入的原始密码与该用户的登录密码不符，请重新输入", vbOKOnly, "系统提示"

Text1.Text = ""

Text1.SetFocus

End If

MsgBox ("密码修改成功")

Exit Sub

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Form_Activate()

On Error GoTo Errp:

Text1.SetFocus

Exit Sub

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)

On Error GoTo Errp:

If KeyCode = 13 Then

Text2.SetFocus

End If

Exit Sub

Errp:

- - 8 -

0582计算机信息管理毕业设计

End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)

On Error GoTo Errp:

If KeyCode = 13 Then

Text3.SetFocus

End If

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)

On Error GoTo Errp:

If KeyCode = 13 Then

cmdOK.SetFocus

End If

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

备份数据是相当重要的，在电脑发生故障时，原来的数据可能丢失，但是您不要担心，您已经备份了数据，可以使原来的数据恢复。《数据备份恢复》代码如下：

Dim MdbComm As New ADODB.Command

Dim MdbSet As New ADODB.Recordset

Dim MdbPara As New ADODB.Parameter

Dim StrUserId As String

Dim StrDate As String

Dim FileName As String

Dim RetVal

Private Sub Command1_Click()

Dim RetVal As String

On Error GoTo Errop:

RetVal = MsgBox("您确定要进行数据备份吗？", vbYesNo, App.Title)

If RetVal = vbYes Then

FileName = "hotelDB.bak"

With DbCommand

.CommandText = "Backup DataBase hotelDB to disk ='d:\" & FileName & "'" .Execute

End With

MsgBox "备份数据成功!", vbOKOnly, App.Title

End If

Exit Sub

Errop:

If Err.Number <> 32755 Then

MsgBox Err.Description, vbOKOnly, App.Title

- - 9 -

0582计算机信息管理毕业设计

End If

End Sub

Private Sub Command2_Click()

On Error GoTo Errop:

FileName = "hotelDB.bak"

With DbCommand

.CommandText = "restore DataBase hotelDB from disk ='app.path + \" & FileName & "'" .Execute

End With

MsgBox "恢复数据成功!", vbOKOnly, App.Title

Exit Sub

Errop:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Command3_Click()

Unload Me

End Sub

Private Sub Form_Load()

On Error GoTo Errp:

StrDate = CStr(Year(Now()))

If Month(Now()) < 10 Then

StrDate = StrDate & "0" & CStr(Month(Now()))

Else

StrDate = StrDate & CStr(Month(Now()))

End If

If Day(Now) < 10 Then

StrDate = StrDate & "0" & CStr(Day(Now()))

Else

StrDate = StrDate & CStr(Day(Now()))

End If

Exit Sub

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Function CheckTableExist(TblName As String) As Boolean

MdbComm.Parameters(0).Value = TblName

MdbComm.Parameters(1).Value = -1

Set MdbSet = MdbComm.Execute

If MdbSet!retu = 1 Then

CheckTableExist = True

Else

CheckTableExist = False

- - 10 -

0582计算机信息管理毕业设计

End If

End Function

打开主界面的“接待管理”，选择“接待登记入住”目的是对帐单号码、主客姓名、证件类型、主客性别、证件号码、出生年月、联系电话、职业、地址、主客手牌号、宾客类型、男宾数量、女宾数量、可打几折、房间总数、鞋牌号码、入店时间、押金、批准人、预计离开时间、已经付款、代人付款、磁卡卡号、是否做到点提示、操作员代码、带水付款、特别说明进行查询。查询完毕后，单击返回按钮，回到主菜单。

<接待登记入住>代码如下：

Private Sub cmmdexit_Click()

Unload Me

End Sub

Private Sub Commsave_Click()

Dim StrSql As String

Dim StrCon As String

Dim sMeg As String

Dim yhbill As String

Dim yhmaster As String

Dim yhsex As String

Dim yhcertificate As String

Dim yhcertify_code As String

Dim yhbirthday As String

Dim yhphone As String

Dim yhaddress As String

Dim yhunit As String

Dim yhmastercode As String

Dim yhguesttype As String

Dim yhrebate As String

Dim yhguestsum As String

Dim yhmale As String

Dim yhfemale As String

Dim yhshoes As String

Dim yhstart As String

Dim yhwillleave As String

Dim yhhousesum As String

Dim yhdeposit As String

Dim yhconfirmpeople As String

Dim yhalreadypaid As String

Dim yhremark As String

Dim yhinputer As String

Dim yhwarning As String

Dim yhcardid As String

Dim yhforother As String

Dim yhforwhose As String

- - 11 -

0582计算机信息管理毕业设计

On Error GoTo Errp:

yhbill = Trim(txtbill.Text)

yhmaster = Trim(txtname.Text)

yhsex = Trim(Comsex.Text)

yhcertificate = Trim(Comzhenjian.Text)

yhcertify_code = Trim(txtzhenjiancode.Text)

yhbirthday = Trim(Txtbirthday.Text)

yhphone = Trim(txtphone.Text)

yhaddress = Trim(txtaddress.Text)

yhunit = Trim(Comzhiye.Text)

yhmastercode = Trim(txthandscode.Text)

yhguesttype = Trim(Comleixing.Text)

yhrebate = Trim(txtzhekou.Text)

yhguestsum = Trim(txtsumcount.Text)

yhmale = Trim(txtmanshuliang.Text)

yhfemale = Trim(txtwomenshuliang.Text)

yhshoes = Trim(txtshoecode.Text)

yhstart = Trim(txtruzhutime.Text)

yhwillleave = Trim(txtleavetime.Text)

yhhousesum = Trim(txtroomcount.Text)

yhdeposit = Trim(txtyajin.Text) yhconfirmpeople = Trim(txtpizhunren.Text) yhalreadypaid = Trim(txtyijingkuan.Text) yhremark = Trim(txtspecial.Text)

yhinputer = Trim(txtcaozuoyuan.Text)

yhwarning = Trim(Compoint.Text)

yhcardid = Trim(txtcikacode.Text)

yhforother = Trim(txtdairenfu.Text)

yhforwhose = Trim(txtdaiwhofu.Text)

If Trim(txtbill.Text) = "" Then

sMeg = "帐单号码"

sMeg = sMeg & "不能为空！"

MsgBox sMeg, vbOKOnly + vbExclamation, "警告" txtbill.SetFocus

Exit Sub

End If

If Len(txtbill.Text) > 6 Then

sMeg = "你的帐单号码大于六位了，请重新输入" MsgBox sMeg, vbOKOnly + vbExclamation, "警告" txtbill.SetFocus

txtbill.Text = ""

Exit Sub

- - 12 -

0582计算机信息管理毕业设计

End If

If Trim(txtname.Text) = "" Then

sMeg = "主客姓名"

sMeg = sMeg & "不能为空！"

MsgBox sMeg, vbOKOnly + vbExclamation, "警告"

txtname.SetFocus

Exit Sub

End If

With DbCommand

.CommandType = adCmdText

.CommandText="insert into bill (bill,master,sex,certificate,certify_code,birthday,phone,address,unit,mastercode,guesttype,rebate,guestsum,male,female,shoes,start,willleave,housesum,deposit,confirmpeople,alreadypaid,remark,inputer,warning,cardid,forother,forwhose)

Set DbTempSet = .Execute

sMeg = "你的输入信息已经保存成功"

MsgBox sMeg, vbOKOnly + vbExclamation, "提示"

End With

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Form_Load()

On Error GoTo Errp:

frmdengji.Top = 1400 frmdengji.Left = 2000 Comzhenjian.AddItem "身份证" Comzhenjian.AddItem "工作证" Comzhenjian.AddItem "学生证"

Comzhenjian.AddItem "警官证"

Comzhenjian.AddItem "驾驶证"

Comzhenjian.AddItem "居住证"

Comzhiye.AddItem "公务员"

Comzhiye.AddItem "学 生"

Comzhiye.AddItem "工 人"

Comzhiye.AddItem "教 师"

Comzhiye.AddItem "农 民"

Comzhiye.AddItem "军 人"

Comzhiye.AddItem "警 察"

Comleixing.AddItem "团体"

Comleixing.AddItem "个人"

Comsex.AddItem "男"

Comsex.AddItem "女"

- - 13 -

0582计算机信息管理毕业设计

Compoint.AddItem "是"

Compoint.AddItem "否"

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

打开主界面的“客房管理”，选择“客房信息查询”目的就是对房间的编号、房间的类型、楼层、预定情况就行查询。选中房间编号，单击查询界面会出现相关的数据，依次类推。最后单击退出按钮回到主界面。

《客房信息查询》代码如下：

Private Sub Commandfresh_Click()

Call Commandquery_Click

End Sub

Private Sub Commandquery_Click()

Dim StrSql As String

Dim StrCon As String

Dim i As Integer

Dim bianhao As String

Dim loucheng As String

Dim roomleixing As String

Dim ordercondition As String

On Error GoTo Errp:

Xsheet.Clear

Xsheet.Refresh

Call BuildTitle

If roombianhao.Value = True Then

bianhao = Trim(PosCbo.Text)

StrSql = "select roomcode,roomtype,floor,phone,roomstutus,reserved,reservetime,freetime,remark,selected,cleaned FROM roomstate where roomcode = '" + bianhao + "'"

End If

If Checkfloor.Value = True Then

loucheng = Mid(Trim(Combofloor.Text), 1, 1)

StrSql =

FROM roomstate where floor = '" + loucheng + "'"

End If

If checkroomstatus.Value = True Then

roomleixing = Trim(PrintCbo.Text)

StrSql="select

roomcode,roomtype,floor,phone,roomstutus,reserved,reservetime,freetime,remark,selected,cleane - - 14 - "select roomcode,roomtype,floor,phone,roomstutus,reserved,reservetime,freetime,remark,selected,cleane

0582计算机信息管理毕业设计

FROM roomstate where roomtype = '" + roomleixing + "'"

End If

If checkorder.Value = True Then

ordercondition = Trim(Comboorder.Text)

StrSql = "select roomcode,roomtype,floor,phone,roomstutus,reserved,reservetime,freetime,remark,selected,cleane FROM roomstate where reserved = '" + ordercondition + "'"

End If

With DbCommand

.CommandText = StrSql

Set DbTempSet = .Execute

End With

With Xsheet

.Rows = 1

Do While Not DbTempSet.EOF

.Rows = .Rows + 1

For i = 1 To DbTempSet.Fields.Count

.TextMatrix(.Rows - 1, i - 1) = DbTempSet.Fields(i - 1)

Next i

DbTempSet.MoveNext

Loop

End With

Exit Sub

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Commandexit_Click()

Unload Me

End Sub

Private Sub Form_Load()

On Error GoTo Errp:

Call BuildTitle '建立表头

With DbCommand

.CommandType = adCmdText

.CommandText = "Select roomcode from roomstate"

Set DbTempSet = .Execute

End With

If Not (DbTempSet.EOF And DbTempSet.BOF) Then

PosCbo.Clear

With DbTempSet

.MoveFirst

While Not .EOF

With PosCbo

- - 15 -

0582计算机信息管理毕业设计

.AddItem (LTrim(RTrim(DbTempSet!roomcode))) End With

.MoveNext

Wend

End With

PosCbo.ListIndex = 0

Else

MsgBox "没有按此编号的客房！", vbOKOnly, App.Title End If

With DbCommand

.CommandText = "Select roomtype from roomstate"

Set DbTempSet = .Execute

End With

If Not (DbTempSet.EOF And DbTempSet.BOF) Then

PrintCbo.Clear

DbTempSet.MoveFirst

While Not DbTempSet.EOF

PrintCbo.AddItem (LTrim(RTrim(DbTempSet!roomtype))) DbTempSet.MoveNext

Wend

PrintCbo.ListIndex = 0

Else

MsgBox "没有此种客房类型！", vbOKOnly, App.Title End If

With DbCommand

.CommandText = "Select floor from roomstate"

Set DbTempSet = .Execute

End With

If Not (DbTempSet.EOF And DbTempSet.BOF) Then

Combofloor.Clear

DbTempSet.MoveFirst

While Not DbTempSet.EOF

Combofloor.AddItem (LTrim(RTrim(DbTempSet!floor))) + "楼" DbTempSet.MoveNext

Wend

Combofloor.ListIndex = 0

Else

MsgBox "此楼没有客房！", vbOKOnly, App.Title

End If

With DbCommand

.CommandText = "Select reserved from roomstate"

Set DbTempSet = .Execute

- - 16 -

0582计算机信息管理毕业设计

End With

If Not (DbTempSet.EOF And DbTempSet.BOF) Then

Comboorder.Clear

DbTempSet.MoveFirst

While Not DbTempSet.EOF

Comboorder.AddItem (LTrim(RTrim(DbTempSet!Reserved))) DbTempSet.MoveNext

Wend

Comboorder.ListIndex = 0

Else

MsgBox "是否已经预订！", vbOKOnly, App.Title

End If

Exit Sub

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub BuildTitle()

On Error GoTo Errp:

With Xsheet

.CellAlignment = flexAlignCenterCenter

.Cols = 11 .TextMatrix(0, 0) = "房间号码" .TextMatrix(0, 1) = "房间类型" .TextMatrix(0, 2) = "所属楼层"

.TextMatrix(0, 3) = "电话分机"

.TextMatrix(0, 4) = "目前状态"

.TextMatrix(0, 5) = "是否预订"

.TextMatrix(0, 6) = "预订时间"

.TextMatrix(0, 7) = "空房时间"

.TextMatrix(0, 8) = "备 注"

.TextMatrix(0, 9) = "已经选中"

.TextMatrix(0, 10) = "已经清扫"

CellAlignment = flexAlignCenterCenter

.ColWidth(0) = 900

.CellAlignment = flexAlignCenterCenter

.ColWidth(1) = 800

.CellAlignment = flexAlignCenterCenter

.ColWidth(2) = 1000

.CellAlignment = flexAlignCenterCenter

.ColWidth(3) = 1000

.CellAlignment = flexAlignCenterCenter

.ColWidth(4) = 1000

.CellAlignment = flexAlignCenterCenter

- - 17 -

0582计算机信息管理毕业设计

.ColWidth(5) = 1000

.CellAlignment = flexAlignCenterCenter .ColWidth(6) = 1500 .CellAlignment = flexAlignCenterCenter .ColWidth(7) = 1200

.CellAlignment = flexAlignCenterCenter

.ColWidth(8) = 1300

.CellAlignment = flexAlignCenterCenter

.ColWidth(9) = 1100

.CellAlignment = flexAlignCenterCenter

.ColWidth(10) = 1200

End With

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

打开主界面的“客房管理”，选择“房型房价查询”目的就是对房型名称、普通价格查询、床位数来进行查询。最后，单击退出回到主界面。《客房类型及客房价格查询》代码如下：

Private Sub Commandexit_Click()

Unload Me

End Sub

Private Sub Commandfresh_Click()

Call Commandquery_Click

End Sub

Private Sub makeTitle()

On Error GoTo Errp:

With Xsheet2

.CellAlignment = flexAlignCenterCenter .Cols = 8 .TextMatrix(0, 0) = "房型代码" .TextMatrix(0, 1) = "房型名称"

.TextMatrix(0, 2) = "详细说明"

.TextMatrix(0, 3) = "普通价格"

.TextMatrix(0, 4) = "长包价格"

.TextMatrix(0, 5) = "优惠价格"

.TextMatrix(0, 6) = "钟点价格"

.TextMatrix(0, 7) = "床位数”

CellAlignment = flexAlignCenterCenter

.ColWidth(0) = 900

- - 18 -

0582计算机信息管理毕业设计

.CellAlignment = flexAlignCenterCenter

.ColWidth(1) = 1800 .CellAlignment = flexAlignCenterCenter .ColWidth(2) = 3000 .CellAlignment = flexAlignCenterCenter

.ColWidth(3) = 1000

.CellAlignment = flexAlignCenterCenter

.ColWidth(4) = 1000

.CellAlignment = flexAlignCenterCenter

.ColWidth(5) = 1000

.CellAlignment = flexAlignCenterCenter

.ColWidth(6) = 1500

.CellAlignment = flexAlignCenterCenter

.ColWidth(7) = 1200

End With

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Commandquery_Click()

Dim StrSqlold As String

Dim StrConold As String

Dim i As Integer

Dim roomleitype As String

Dim roomprice As String

Dim roombedsum As String

On Error GoTo Errp:

Xsheet2.Clear

Xsheet2.Refresh

Call makeTitle

If roomleixing.Value = True Then

roomleitype = Trim(leixingCbo.Text)

StrSqlold = "select typeorder,roomtype,explain,price1,price2,price3,price4,bed_num FROM shaparoom where roomtype = '" + roomleitype + "'"

End If

If pricequery.Value = True Then

roomprice = Trim(commonpriceCbo.Text)

StrSqlold = "select typeorder,roomtype,explain,price1,price2,price3,price4,bed_num FROM shaparoom where price1 = '" + roomprice + "'"

End If

If bedcount.Value = True Then

roombedsum = Trim(bedcountcom.Text)

- - 19 -

0582计算机信息管理毕业设计

StrSqlold = "select typeorder,roomtype,explain,price1,price2,price3,price4,bed_num FROM shaparoom where bed_num = '" + roombedsum + "'"

End If

With DbCommand

.CommandText = StrSqlold

Set DbTempSet = .Execute

End With

With Xsheet2

.Rows = 1

Do While Not DbTempSet.EOF

.Rows = .Rows + 1

For i = 1 To DbTempSet.Fields.Count

.TextMatrix(.Rows - 1, i - 1) = DbTempSet.Fields(i - 1)

Next i

DbTempSet.MoveNext

Loop

End With

Exit Sub

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Form_Load()

On Error GoTo Errp:

frmroomprice.Top = 1400

frmroomprice.Left = 2000

Call makeTitle '建立表头

With DbCommand

.CommandType = adCmdText

.CommandText = "Select roomtype from shaparoom"

Set DbTempSet = .Execute

End With

If Not (DbTempSet.EOF And DbTempSet.BOF) Then

leixingCbo.Clear

With DbTempSet

.MoveFirst

While Not .EOF

With leixingCbo

.AddItem (LTrim(RTrim(DbTempSet!roomtype)))

End With

- - 20 -

0582计算机信息管理毕业设计

.MoveNext

Wend

End With

leixingCbo.ListIndex = 0

Else

MsgBox "没有此种房间类型！", vbOKOnly, App.Title

End If

With DbCommand

.CommandText = "Select price1 from shaparoom"

Set DbTempSet = .Execute

End With

If Not (DbTempSet.EOF And DbTempSet.BOF) Then

commonpriceCbo.Clear

DbTempSet.MoveFirst

While Not DbTempSet.EOF

commonpriceCbo.AddItem (LTrim(RTrim(DbTempSet!price1))) DbTempSet.MoveNext

Wend

commonpriceCbo.ListIndex = 0

Else

MsgBox "没有此种价格的房间！", vbOKOnly, App.Title

End If

With DbCommand

.CommandText = "Select bed_num from shaparoom"

Set DbTempSet = .Execute

End With

If Not (DbTempSet.EOF And DbTempSet.BOF) Then

bedcountcom.Clear

DbTempSet.MoveFirst

While Not DbTempSet.EOF

bedcountcom.AddItem (LTrim(RTrim(DbTempSet!bed_num))) DbTempSet.MoveNext

Wend

bedcountcom.ListIndex = 0

Else

MsgBox "没有此种床位数的房间！", vbOKOnly, App.Title End If

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single) - - 21 -

0582计算机信息管理毕业设计

End Sub

打开主界面的“客房管理”，选择“客人消费明细”目的就是按账单号、收牌号等进行查询。单击查询出现相关的数据，最后单击退出回到主界面。《客人消费明细查询》代码如下：

Private Sub Commandexit_Click()

Unload Me

End Sub

Private Sub Commandquery_Click()

Dim StrSqlnew As String

Dim StrConnew As String

Dim i As Integer

Dim zhangdanma As String

Dim shoupaima As String

On Error GoTo Errp:

Xsheet3.Clear

Xsheet3.Refresh

Call madeTitle

If Optionzhangdan.Value = True Then

zhangdanma = Trim(comzhangdan.Text)

StrSqlnew = "select handscode,bill,itemid,itemcode,itemtype,itemname,spec,unit,price,num,totalsum,inputwhere,inputer,inputtime,waiter,pay_atonce,striked FROM itemthink where bill = '" + zhangdanma + "'" End If

If Optionshoupaiquery.Value = True Then

shoupaima = Trim(Comshoupai.Text)

StrSqlnew = "select handscode,bill,itemid,itemcode,itemtype,itemname,spec,unit,price,num,totalsum,inputwhere,inputer,inputtime,waiter,pay_atonce,striked from itemthink where handscode = '" + shoupaima + "'" End If

With DbCommand

.CommandText = StrSqlnew

Set DbTempSet = .Execute

End With

With Xsheet3

.Rows = 1

Do While Not DbTempSet.EOF

.Rows = .Rows + 1

For i = 1 To DbTempSet.Fields.Count

.TextMatrix(.Rows - 1, i - 1) = DbTempSet.Fields(i - 1)

Next i

DbTempSet.MoveNext

- - 22 -

0582计算机信息管理毕业设计

Loop

End With

Exit Sub

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Form_Load()

frmcostitem.Top = 1400

frmcostitem.Left = 1100

On Error GoTo Errp:

Call madeTitle '建立表头

With DbCommand

.CommandType = adCmdText

.CommandText = "Select bill from itemthink"

Set DbTempSet = .Execute

End With

If Not (DbTempSet.EOF And DbTempSet.BOF) Then

comzhangdan.Clear

With DbTempSet

.MoveFirst

While Not .EOF

With comzhangdan

.AddItem (LTrim(RTrim(DbTempSet!bill)))

End With

.MoveNext

Wend

End With

comzhangdan.ListIndex = 0

Else

MsgBox "没有按此帐单号码消费的客人明细！", vbOKOnly, App.Title End If

With DbCommand

.CommandText = "Select handscode from itemthink"

Set DbTempSet = .Execute

End With

If Not (DbTempSet.EOF And DbTempSet.BOF) Then

Comshoupai.Clear

DbTempSet.MoveFirst

While Not DbTempSet.EOF

Comshoupai.AddItem (LTrim(RTrim(DbTempSet!handscode))) DbTempSet.MoveNext

Wend

Comshoupai.ListIndex = 0

- - 23 -

0582计算机信息管理毕业设计

Else

MsgBox "没有按此手牌号码消费的客人明细！", vbOKOnly, App.Title End If

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub madeTitle()

On Error GoTo Errp:

With Xsheet3

.CellAlignment = flexAlignCenterCenter

.Cols = 17

.TextMatrix(0, 0) = "手牌号码"

.TextMatrix(0, 1) = "帐单号码"

.TextMatrix(0, 2) = "项目识别码"

.TextMatrix(0, 3) = "项目代码"

.TextMatrix(0, 4) = "项目类型"

.TextMatrix(0, 5) = "项目名称"

.TextMatrix(0, 6) = "规 格"

.TextMatrix(0, 7) = "单 位"

.TextMatrix(0, 8) = "单 价" .TextMatrix(0, 9) = "数 量" .TextMatrix(0, 10) = "金 额" .TextMatrix(0, 11) = "录入工作站"

.TextMatrix(0, 12) = "操作人员"

.TextMatrix(0, 13) = "录入时间"

.TextMatrix(0, 14) = "技师工号"

.TextMatrix(0, 15) = "立即付款"

.TextMatrix(0, 16) = "是否已付款”

.CellAlignment = flexAlignCenterCenter

.ColWidth(0) = 900

.CellAlignment = flexAlignCenterCenter

.ColWidth(1) = 900

.CellAlignment = flexAlignCenterCenter

.ColWidth(2) = 900

.CellAlignment = flexAlignCenterCenter

.ColWidth(3) = 900

.CellAlignment = flexAlignCenterCenter

.ColWidth(4) = 1000

.CellAlignment = flexAlignCenterCenter

.ColWidth(5) = 1000

.CellAlignment = flexAlignCenterCenter

.ColWidth(6) = 900

- - 24 -

0582计算机信息管理毕业设计

.CellAlignment = flexAlignCenterCenter

.ColWidth(7) = 900 .CellAlignment = flexAlignCenterCenter .ColWidth(8) = 900 .CellAlignment = flexAlignCenterCenter

.ColWidth(9) = 900

.CellAlignment = flexAlignCenterCenter

.ColWidth(10) = 1000

.CellAlignment = flexAlignCenterCenter

.ColWidth(11) = 1000

.CellAlignment = flexAlignCenterCenter

.ColWidth(12) = 1000

.CellAlignment = flexAlignCenterCenter

.ColWidth(13) = 1000

.CellAlignment = flexAlignCenterCenter

.ColWidth(14) = 1000

.CellAlignment = flexAlignCenterCenter

.ColWidth(15) = 900

.CellAlignment = flexAlignCenterCenter

.ColWidth(16) = 900

.ColWidth(7) = 1200

End With

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

打开系统帮助下的“关于系统” 就是对有关方面加以说明。《关于系统》代码如下：

Private Sub Command1_Click()

Call StartSysInfo

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

Private Sub Form_Click()

Unload Me

End Sub

Private Sub Form_Load()

On Error GoTo Errp:

Call GetUserInfo

UserLBL.Caption = usernamenew

companyLBL.Caption = CompanyName

- - 25 -

0582计算机信息管理毕业设计

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Image1_Click()

Unload Me

End Sub

打开主界面的退出系统，输入退出系统密码，回到了VB主程序窗体。《系统退出》代码如下：

Private Sub Command1_Click()

On Error GoTo Errp:

With DbCommand

'.CommandText = "Select userPassword from hotellogin where username ='" & zhou & "'" .CommandText = "Select userPassword from hotellogin where username ='zhou'" Set DbTempSet = .Execute

End With

If Not (DbTempSet.EOF And DbTempSet.BOF) Then

If LTrim(RTrim(DbTempSet!userPassword)) <> LTrim(RTrim(Text1.Text)) Then With DbCommand

.CommandText = "Select userPassword from hotellogin where username='Administrator'"

Set DbTempSet = .Execute

End With

If Not (DbTempSet.BOF And DbTempSet.EOF) Then

If LTrim(RTrim(DbTempSet!userPassword)) <> LTrim(RTrim(Text1.Text)) Then MsgBox "您输入的密码不是当前用户的密码，也不是超级用户的密码", vbOKOnly, App.Title

Text1.Text = ""

Text1.SetFocus

Else

Unload Me

DbConn.Close

Unload frmMain

End If

Else

MsgBox "您输入的当前用户的密码不正确，请重新输入密码！", vbOKOnly, App.Title

Text1.Text = ""

Text1.SetFocus

End If

Else

Unload Me

DbConn.Close

- - 26 -

0582计算机信息管理毕业设计

Unload frmMain

End If

Else

With DbCommand

.CommandText

username='Administrator'"

Set DbTempSet = .Execute

End With

If Not (DbTempSet.BOF And DbTempSet.EOF) Then

If LTrim(RTrim(DbTempSet!userPassword)) <> LTrim(RTrim(Text1.Text)) Then MsgBox "您输入的密码不是当前用户的密码，也不是超级用户的密码", vbOKOnly, App.Title

Text1.Text = ""

Text1.SetFocus

Else

Unload Me

DbConn.Close

Unload frmMain

End If

Else

MsgBox "您输入的当前用户的密码不正确，请重新输入密码！", vbOKOnly, App.Title

Text1.Text = ""

Text1.SetFocus

End If

End If

Exit Sub

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

Private Sub Form_Activate()

Text1.SetFocus

End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)

On Error GoTo Errp:

If KeyCode = 13 Then

Command1.SetFocus

End If

Exit Sub

- - 27 - = "Select userPassword from hotellogin where

0582计算机信息管理毕业设计

Errp:

MsgBox Err.Description, vbOKOnly, App.Title

End Sub

以下是模块编码：

Serverstart（Serverstart.bas）

Option Explicit

Public DbConn As New ADODB.Connection

Public DbCommand As New ADODB.Command

Public DbTempSet As New ADODB.Recordset

Public AppRun As Boolean

Public LoginSucceeded As Boolean

Public UserId As String '此变量的目的是为了存储登陆界面中的用户名称

Sub Main()

On Error GoTo errHandle '对系统进行错误处理

'控制程序运行次数

If App.PrevInstance Then

MsgBox "娱乐休闲型酒店管理信息系统已启动,不能再次启动", vbInformation + vbOKOnly

End

End If

Call get_text

With DbConn

If .State <> adStateClosed Then

.Close

End If

End With

DbConn.Open "Persist Security Info=True;User ID=" & uid & ";Password=" & pwd & ";Data Source=" & dsn '连接数据库的程序

If DbConn.State = adStateOpen Then

AppRun = False

frmLogin.Show vbModal

DoEvents

'登录成功

If LoginSucceeded Then

AppRun = True

frmMain.Show

Else

Exit Sub

- - 28 -

0582计算机信息管理毕业设计

End If

End If

Exit Sub

errHandle:

MsgBox "数据库连接失败，请检查配置文件是否正确！", vbOKOnly, App.Title Resume Next

End Sub

Sysfunction （Sysfunction.bas）

Option Explicit

Public dsn As String

Public uid As String

Public pwd As String

Public username As String

Public CompanyName As String

Public usernamenew As String '此变量是为了将用户名称显示在关于系统(frmaboutsys)窗体中

' 注册表关键字安全选项...

Const READ_CONTROL = &H20000

Const KEY_QUERY_VALUE = &H1

Const KEY_SET_VALUE = &H2

Const KEY_CREATE_SUB_KEY = &H4

Const KEY_ENUMERATE_SUB_KEYS = &H8

Const KEY_NOTIFY = &H10

Const KEY_CREATE_LINK = &H20

Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _

KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _

KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

' 注册表关键字 ROOT 类型...

Const HKEY_LOCAL_MACHINE = &H80000002

Const ERROR_SUCCESS = 0

Const REG_SZ = 1 ' 独立的空的终结字符串

Const REG_DWORD = 4 ' 32位数字

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"

Const gREGVALSYSINFOLOC = "MSINFO"

Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"

Const gREGVALSYSINFO = "PATH"

Const SM_CXSCREEN = 0

Const SM_CYSCREEN = 1

- - 29 -

0582计算机信息管理毕业设计

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.

'Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long

'*******************************************

'* 从manager.ini中获得数据库配置信息 *

'*******************************************

Public Sub get_text()

Dim file_obj As Scripting.TextStream '需要引用相关的类型

Dim file_open As Scripting.FileSystemObject

Dim tmp_str As String

Dim str_arr() As String

Dim str_title As String

Dim i, k As Integer

ReDim str_arr(0, 3) As String

Set file_open = New Scripting.FileSystemObject

Set file_obj = file_open.OpenTextFile(App.Path & "\manager.ini")

i = 0

k = 0

Do While Not file_obj.AtEndOfStream

tmp_str = Trim(file_obj.ReadLine)

str_title = split_by(tmp_str)

str_arr(0, i) = str_title

- - 30 -

0582计算机信息管理毕业设计

i = i + 1

Loop file_obj.Close uid = str_arr(0, 0) pwd = str_arr(0, 1)

dsn = str_arr(0, 2)

End Sub

'****************************************************************************** '*用来截取manager.ini文件中的（User ID，password,Data Source)这三个变量的具体数值* '****************************************************************************** Public Function split_by(tmp_str As String) As String

Dim i, k As Integer

Dim str_arr As String

k = Len(tmp_str)

i = InStr(1, tmp_str, "=", 0)

str_arr = Mid(tmp_str, i + 1, k)

split_by = str_arr

End Function

Public Sub GetUserInfo()

Dim file_obj As Scripting.TextStream Dim file_open As Scripting.FileSystemObject Dim tmp_str As String Dim str_arr() As String

Dim str_title As String

Dim i, k As Integer

ReDim str_arr(0, 2) As String

Set file_open = New Scripting.FileSystemObject

Set file_obj = file_open.OpenTextFile(App.Path & "\Reg.ini")

i = 0

k = 0

Do While Not file_obj.AtEndOfStream

tmp_str = Trim(file_obj.ReadLine)

str_title = split_by(tmp_str)

str_arr(0, i) = str_title

i = i + 1

Loop

file_obj.Close

usernamenew = str_arr(0, 0)

CompanyName = str_arr(0, 1)

End Sub

Public Sub StartSysInfo()

On Error GoTo SysInfoErr

- - 31 -

0582计算机信息管理毕业设计

Dim rc As Long

Dim SysInfoPath As String

' 试图从注册表中获得系统信息程序的路径及名称...

If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then

' 试图仅从注册表中获得系统信息程序的路径...

Else

If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then

' 已知32位文件版本的有效位置

If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then

SysInfoPath = SysInfoPath & "\MSINFO32.EXE"

' 错误 - 文件不能被找到...

Else

GoTo SysInfoErr

End If

' 错误 - 注册表相应条目不能被找到...

Else

GoTo SysInfoErr

End If

Call Shell(SysInfoPath, vbNormalFocus)

Exit Sub

SysInfoErr:

MsgBox "此时系统信息不可用", vbOKOnly

End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean

Dim i As Long ' 循环计数器

Dim rc As Long ' 返回代码

Dim hKey As Long ' 打开的注册表关键字句柄 Dim hDepth As Long '

Dim KeyValType As Long ' 注册表关键字数据类型 Dim tmpVal As String ' 注册表关键字值的临时存储器 Dim KeyValSize As Long ' 注册表关键自变量的尺寸 '------------------------------------------------------------

' 打开 {HKEY_LOCAL_MACHINE...} 下的 RegKey

'------------------------------------------------------------

rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' 打开注册表关- - 32 -

0582计算机信息管理毕业设计

键字

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 处理错误...

tmpVal = String$(1024, 0) ' 分配变量空间

KeyValSize = 1024 ' 标记变量尺寸

'------------------------------------------------------------

' 检索注册表关键字的值...

'------------------------------------------------------------

rc = RegQueryValueEx(hKey, SubKeyRef, 0, _

KeyValType, tmpVal, KeyValSize) ' 获得/创建关键字值 If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 处理错误

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 外接程序空终结字符串... tmpVal = Left(tmpVal, KeyValSize - 1) ' Null 被找到,从字符串中分离出来 Else ' WinNT 没有空终结字符串... tmpVal = Left(tmpVal, KeyValSize) ' Null 没有被找到, 分离字符串 End If

'------------------------------------------------------------

' 决定转换的关键字的值类型...

'------------------------------------------------------------

Select Case KeyValType ' 搜索数据类型...

Case REG_SZ ' 字符串注册关键字数据类型 KeyVal = tmpVal ' 复制字符串的值

Case REG_DWORD ' 四字节的注册表关键字数据类型 For i = Len(tmpVal) To 1 Step -1 ' 将每位进行转换

KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' 生成值字符。 By Char。 Next

KeyVal = Format$("&h" + KeyVal) ' 转换四字节的字符为字符串

End Select

GetKeyValue = True ' 返回成功

rc = RegCloseKey(hKey) ' 关闭注册表关键字 Exit Function ' 退出

GetKeyError: ' 错误发生后将其清除... KeyVal = "" ' 设置返回值到空字符串 GetKeyValue = False ' 返回失败

rc = RegCloseKey(hKey) ' 关闭注册表关键字 End Function

编写模块代码目的是实现数据库的连接。如果是连接成功直接进入登录界面，进行其他的操作。如果连接失败，则直接退出系统。

以上是娱乐休闲型酒店管理信息系统的程序设计。

- - 33 -