login.frm

Hotel Prog in VB using mdb

Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'欢迎你下载使用本代码，本份代码由程序太平洋提供下载学习之用
'声明:
'1.本站所有代码的版权归原作者所有，如果你使用了在本站下载的源代码
'  引起的一切纠纷(后果)与本站无关,请您尊重原作者的劳动成果！
'2.若本站在代码上有侵权之处请您与站长联系，站长会及时更正。
'网站：http://www.dapha.net
'论坛：http://www.5ivb.net
'Email:[e-mail]
'CopyRight 2001-2005 By dapha.net
'整理时间：2003-12-8 12:22:14

'星级酒店管理系统最初功能演示版,提供所有星级酒店管理中的客房管理,
'房态管理,客史管理,客人资料管理,帐务管理,报表管理,餐饮收费管理
'菜谱管理,夜审处理,数据库备份等功能.所有功能皆可以运行,(但有一些BUG未处理)
'此代码完全可以完成星级酒店上述管理功能.(提供者:帅)
'--------------------------------------------------------------
'代码编写于:2001.12  系统分析:帅   代码编写:帅    版权所有:帅
'--------------------------------------------------------------
'本份代码仅提供给程序太平洋的所有朋友学习,研究之用.
'其它网站一律不得转载,否则为侵权行为,本人保留法律追诉权力.
'这也是本人最早的VB版程序,代码质量不好.望笑纳.:)
'--------------------------------------------------------------
'提供日期:2003-05-31    提供者:帅
'--------------------------------------------------------------
'系统提从与ACCESS或SQL相接,在登录时,选择全局数据库,就与SQL数据库
'连接,字符串存放在SERVER.DAT文本文件中;选择本地数据库,与本地ACCESS
'数据库相连,连接字符串存放在LOCAT.DAT文件中.(当前存放为e:\hotel2\room.mdb)
'---------------------------------------------------------------
'将ACCESS中所有表导入SQL中,并将有的表中的ID字段改为自动编码,就可以使用.
'---------------------------------------------------------------------
'
'

Private Sub Combo1_KeyPress(KeyAscii As Integer)
    Combo1.Text = "全局服务器"
    Command3.SetFocus
    
End Sub

Private Sub Command1_Click()
    Dim MeVer As String
    Dim Czy_Type As String
    Dim strPass As String
    Dim bz0 As Integer
    Dim i As Integer
    
    MeVer = "2003.01.001"
    
    Registration_Type = ""
    Account_ID = ""
    QAccount_ID = ""
    
    On Error GoTo ERR_13
    
    If Len(Text1) > 0 Then
                Adodc1.ConnectionString = My_PROVIDER
                Adodc1.CommandType = adCmdText
                Adodc1.RecordSource = "select * from 用户 where username like '" & Me.Text1.Text & "' and userno like '" & Me.Text2.Text & "'"
                Adodc1.Refresh
                CzyPassWord = Me.Text2.Text
                If Adodc1.Recordset.RecordCount > 0 Then
                PASSed1 = True
                CzyName = Text1
                CzyType = Adodc1.Recordset.Fields("usertype")
                Czy_Type = Adodc1.Recordset.Fields("user_type")
                
                Adodc1.Recordset.Close
                Adodc1.ConnectionString = My_PROVIDER
                Adodc1.CommandType = adCmdText
                Adodc1.RecordSource = "select * from 参数"
                Adodc1.Refresh
                Account_ID = Format(Adodc1.Recordset.Fields("帐号"), "000000")
                System_Date = Adodc1.Recordset.Fields("系统日期")
                Half_times = Adodc1.Recordset.Fields("退房半价始时间")
                Half_time = Adodc1.Recordset.Fields("退房半价终时间")
                System_Statu = Adodc1.Recordset.Fields("系统状态")
                TongZhi = IIf(IsNull(Adodc1.Recordset.Fields("通知")), "", Adodc1.Recordset.Fields("通知"))
                SoftVerSion = Adodc1.Recordset.Fields("版本号")
                Adodc1.Recordset.Close
                If MeVer <> SoftVerSion Then
                    MsgBox "重要提示：" & Chr(13) & Chr(13) & "    当前软件已升级到" & SoftVerSion & "版，请到服务器下载新软件后，" & Chr(13) & Chr(13) & "再运行升级软件！", 64, "升级提示"
                    PASSed1 = False
                    Unload Me
                End If
                If TongZhi <> "" Then
                    MsgBox "通知：" & Chr(13) & Chr(13) & TongZhi, 64, "通知"
                End If
                If System_Statu = "正常" Then
                    Unload Me
                Else
                    MsgBox "请稍候：系统现在正处于  [" & System_Statu & "] 状态！", 64, "提示"
                    PASSed1 = False
                    Unload Me
                End If
                Else
                    MsgBox "请注意：用户名或口令错误！", 48, "错误信息"
                    
                End If
                
    Else
        MsgBox "请输入您的姓名", 48, "提示信息"
    End If
    
    
    Exit Sub
    
ERR_13:
    MsgBox Err.Description & " 或服务器登录失败，请检查或与系统管理员联系！", 48, "提示"
    Exit Sub
    
End Sub

Private Sub Command2_Click()
    PASSed1 = False
    Unload Me
    
End Sub


Private Sub Command3_Click()
    Dim i, j, Field_COUNT As Integer
    Dim strCMD As Command

    
    If Combo1.Text = "全局服务器" Then
        Open App.Path & "\server.dat" For Input As #1
        Input #1, FP_ZDLX
        Input #1, My_USERID
        Input #1, My_PASSWORD
        Input #1, My_DATASOURCE
        Input #1, My_INITIALCATALOG
        Input #1, My_PROVIDER
        Input #1, BK_PROVIDER
        Close #1
        DATA_SERVER = "全局服务器"
    Else
        If Combo1.Text = "本地服务器" Then
        Open App.Path & "\locat.dat" For Input As #1
        Input #1, FP_ZDLX
        Input #1, My_USERID
        Input #1, My_PASSWORD
        Input #1, My_DATASOURCE
        Input #1, My_INITIALCATALOG
        Input #1, My_PROVIDER
        Input #1, BK_PROVIDER
        Close #1
        DATA_SERVER = "本地服务器"
        Me.Check1.Value = 0
        Else
            MsgBox "请注意：服务器选择错误！", 48, "提示"
            Combo1.Text = "全局服务器"
            Combo1.SetFocus
            Exit Sub
        End If

    End If
    Me.Command1.Enabled = True
    Me.Text1.SetFocus
    
    Exit Sub
    
Err_Process:
   MsgBox "信息：操作错误！", 16, "警告"
   Exit Sub
End Sub

Private Sub Form_Load()

    On Error GoTo Err_Process1
    
    封面.Show 1
    RoomNO = ""
    Room_Rate = 0
    
    TableName(0) = "CATVUSER"
    TableName(1) = "SF"
    TableName(2) = "USER_AZ"
    TableName(3) = "USER_BQ"
    TableName(4) = "USER_BT"
    TableName(5) = "USER_FT"
    TableName(6) = "USER_GH"
    TableName(7) = "USER_HF"
    TableName(8) = "USER_XH"
    TableName(9) = "USER_ZD"
    TableName(10) = "菜单"
    TableName(11) = "参数"
    TableName(12) = "发票栏目原始数据"
    TableName(13) = "发票自定义"
    TableName(14) = "各类业务收费标准"
    TableName(15) = "扩展参数"
    TableName(16) = "片区"
    TableName(17) = "安装工"
    TableName(18) = "收费标准"
    TableName(19) = "收费类型"
    TableName(20) = "用户"
    TableName(21) = "终端类型"

    Me.Combo1.AddItem "全局服务器"
    Me.Combo1.AddItem "本地服务器"
    
    Open App.Path & "\BKPIC.dat" For Input As #1
    Input #1, BKPicPath
    Input #1, PianQu
    Input #1, DWMC
    Close #1
                
    Open App.Path & "\server.dat" For Input As #1
    Input #1, My_USERID
    Input #1, My_PASSWORD
    Input #1, My_DATASOURCE
    Input #1, My_INITIALCATALOG
    Input #1, My_PROVIDER
    Close #1
    PASSed1 = False
    
    

    Exit Sub
    
Err_Process1:
    MsgBox "错误信息：读取系统参数错误！", 64, "警告"
    Exit Sub
    
End Sub

Private Sub Form_Unload(Cancel As Integer)


    Unload Me
    
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = Asc(Chr(13)) Then
        Text2.SetFocus
    End If
        
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = Asc(Chr(13)) Then
        If Command1.Enabled Then
            Command1.SetFocus
        Else
            MsgBox "请注意：您未连接到数据库服务器！", 48, "提示"
            Text2.SetFocus
        End If
    End If

End Sub