⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 客史查询.frm

📁 本站资料仅为大家学习之用
💻 FRM
📖 第 1 页 / 共 3 页
字号:
'Email:dapha@etang.com
'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字段改为自动编码,就可以使用.
'---------------------------------------------------------------------
'
'
Dim SFZ As String
Dim DJ_query As Boolean
Dim DATA_edit As Boolean
Dim Field_Type As Integer
Dim Field_Value As String
Dim FindFieldC As String
Dim ZH_find As String
Dim ZH_find1 As String
Dim ZH_ysh As String
Dim SF_BG As Boolean
Dim BD_BG As Boolean
Dim Or_Field As String
Dim US_Field As String
Dim Data_Rec As Long
Dim TY_XG As Boolean
Dim FB_table1 As String


Private Sub Command4_Click()
    On Error GoTo ERR_pro201

    Picture1.Visible = False
    If Me.Option1.Value Then
        ZH_ysh = " like "
    End If
    If Me.Option2.Value Then
        ZH_ysh = " >= "
    End If
    If Me.Option3.Value Then
        ZH_ysh = " <= "
    End If
    If Me.Option4.Value Then
        ZH_ysh = " = "
    End If
    If Me.Option5.Value Then
        ZH_ysh = " <> "
    End If
    If Me.Option6.Value Then
        ZH_ysh = " like "
    End If

            Field_Value = Field_Z.Text
            'MsgBox Field_Type
            If Field_Value <> "" Then
                If Field_Value = "null" Or field_valu = "NULL" Then
                If ZH_find1 = "" Then
                '空值,单级
                    'ZH_find1 = FindFieldC & " like " & "'" & Field_Value & "'"
                    If Me.Option6.Value Then
                        If Field_Type = 200 Then ZH_find1 = " not " & FindFieldC & " is null"
                        If Field_Type = 202 Then ZH_find1 = " not " & FindFieldC & " is null"
                        If Field_Type = 7 Then ZH_find1 = " not " & FindFieldC & " is null"
                        If Field_Type = 135 Then ZH_find1 = " not " & FindFieldC & " is null"
                        If Field_Type = 2 Then ZH_find1 = " not " & FindFieldC & " is null"
                        If Field_Type = 6 Then ZH_find1 = " not " & FindFieldC & " is null"
                    Else
                        If Field_Type = 200 Then ZH_find1 = FindFieldC & " is null"
                        If Field_Type = 202 Then ZH_find1 = FindFieldC & " is null"
                        If Field_Type = 7 Then ZH_find1 = FindFieldC & " is null"
                        If Field_Type = 135 Then ZH_find1 = FindFieldC & " is null"
                        If Field_Type = 2 Then ZH_find1 = FindFieldC & " is null"
                        If Field_Type = 6 Then ZH_find1 = FindFieldC & " is null"
                    End If
                Else
                    '空值,多级
                    'ZH_find1 = ZH_find1 & " and " & FindFieldC & " like " & "'" & Field_Value & "'"
                    If Me.Option6.Value Then
                        If Field_Type = 200 Then ZH_find1 = ZH_find1 & " and not " & FindFieldC & " is null"
                        If Field_Type = 202 Then ZH_find1 = ZH_find1 & " And not " & FindFieldC & " is null"
                        If Field_Type = 7 Then ZH_find1 = ZH_find1 & " and not " & FindFieldC & " is null"
                        If Field_Type = 135 Then ZH_find1 = ZH_find1 & " and not " & FindFieldC & " is null"
                        If Field_Type = 2 Then ZH_find1 = ZH_find1 & " and not " & FindFieldC & " is null"
                        If Field_Type = 6 Then ZH_find1 = ZH_find1 & " and not " & FindFieldC & " is null"
                    Else
                        If Field_Type = 200 Then ZH_find1 = ZH_find1 & " and " & FindFieldC & " is null"
                        If Field_Type = 202 Then ZH_find1 = ZH_find1 & " And " & FindFieldC & " is null"
                        If Field_Type = 7 Then ZH_find1 = ZH_find1 & " and  " & FindFieldC & " is null"
                        If Field_Type = 135 Then ZH_find1 = ZH_find1 & " and " & FindFieldC & " is null"
                        If Field_Type = 2 Then ZH_find1 = ZH_find1 & " and " & FindFieldC & " is null"
                        If Field_Type = 6 Then ZH_find1 = ZH_find1 & " and " & FindFieldC & " is null"
                    End If
                End If
                
                Else
                If ZH_find1 = "" Then
                    '非空值,单级
                    'ZH_find1 = FindFieldC & " like " & "'" & Field_Value & "'"
                    If Me.Option6.Value Then
                        If Field_Type = 200 Then ZH_find1 = " (not " & FindFieldC & ZH_ysh & "'" & Field_Value & "' or " & FindFieldC & " is null)"
                        If Field_Type = 202 Then ZH_find1 = " (not " & FindFieldC & ZH_ysh & "'" & Field_Value & "' or " & FindFieldC & " is null)"
                        If Field_Type = 7 Then ZH_find1 = " (not " & FindFieldC & ZH_ysh & "#" & CDate(Field_Value) & "# or " & FindFieldC & " is null)"
                        If Field_Type = 135 Then ZH_find1 = " (not " & FindFieldC & ZH_ysh & "#" & CDate(Field_Value) & "# or " & FindFieldC & " is null)"
                        If Field_Type = 2 Then ZH_find1 = " (not " & FindFieldC & ZH_ysh & CInt(Field_Value) & " or " & FindFieldC & " is null)"
                        If Field_Type = 6 Then ZH_find1 = " (not " & FindFieldC & ZH_ysh & CInt(Field_Value) & " or " & FindFieldC & " is null)"
                    Else
                        If Field_Type = 200 Then ZH_find1 = FindFieldC & ZH_ysh & "'" & Field_Value & "'"
                        If Field_Type = 202 Then ZH_find1 = FindFieldC & ZH_ysh & "'" & Field_Value & "'"
                        If Field_Type = 7 Then ZH_find1 = FindFieldC & ZH_ysh & "#" & CDate(Field_Value) & "#"
                        If Field_Type = 135 Then ZH_find1 = FindFieldC & ZH_ysh & "#" & CDate(Field_Value) & "#"
                        If Field_Type = 2 Then ZH_find1 = FindFieldC & ZH_ysh & CInt(Field_Value)
                        If Field_Type = 6 Then ZH_find1 = FindFieldC & ZH_ysh & CInt(Field_Value)
                    End If
                Else
                    '非空值,多级
                    'ZH_find1 = ZH_find1 & " and " & FindFieldC & " like " & "'" & Field_Value & "'"
                    If Me.Option6.Value Then
                        If Field_Type = 200 Then ZH_find1 = ZH_find1 & " and (not " & FindFieldC & ZH_ysh & "'" & Field_Value & "' or " & FindFieldC & " is null)"
                        If Field_Type = 202 Then ZH_find1 = ZH_find1 & " And (not " & FindFieldC & ZH_ysh & " '" & Field_Value & "' or " & FindFieldC & " is null)"
                        If Field_Type = 7 Then ZH_find1 = ZH_find1 & " and (not " & FindFieldC & ZH_ysh & "#" & CDate(Field_Value) & "# or " & FindFieldC & " is null)"
                        If Field_Type = 135 Then ZH_find1 = ZH_find1 & " and (not " & FindFieldC & ZH_ysh & "#" & CDate(Field_Value) & "# or " & FindFieldC & " is null)"
                        If Field_Type = 2 Then ZH_find1 = ZH_find1 & " and (not " & FindFieldC & ZH_ysh & CInt(Field_Value) & " or " & FindFieldC & " is null)"
                        If Field_Type = 6 Then ZH_find1 = ZH_find1 & " and (not " & FindFieldC & ZH_ysh & CInt(Field_Value) & " or " & FindFieldC & " is null)"
                    Else
                        If Field_Type = 200 Then ZH_find1 = ZH_find1 & " and " & FindFieldC & ZH_ysh & "'" & Field_Value & "'"
                        If Field_Type = 202 Then ZH_find1 = ZH_find1 & " And " & FindFieldC & ZH_ysh & " '" & Field_Value & "'"
                        If Field_Type = 7 Then ZH_find1 = ZH_find1 & " and  " & FindFieldC & ZH_ysh & "#" & CDate(Field_Value) & "#"
                        If Field_Type = 135 Then ZH_find1 = ZH_find1 & " and " & FindFieldC & ZH_ysh & "#" & CDate(Field_Value) & "#"
                        If Field_Type = 2 Then ZH_find1 = ZH_find1 & " and " & FindFieldC & ZH_ysh & CInt(Field_Value)
                        If Field_Type = 6 Then ZH_find1 = ZH_find1 & " and " & FindFieldC & ZH_ysh & CInt(Field_Value)
                    End If

                End If
                
                End If
                '多级与单级分类
                If DJ_query Then
                    ZH_find = " where " & ZH_find1
                Else
                    'ZH_find = " where " & FindFieldC & " like " & "'" & Field_Value & "'"
                If Field_Value = "null" Or field_valu = "NULL" Then
                '空值
                    If Me.Option6.Value Then
                        If Field_Type = 200 Then ZH_find = " where not " & FindFieldC & " is null"
                        If Field_Type = 202 Then ZH_find = " where not " & FindFieldC & " is null"
                        If Field_Type = 7 Then ZH_find = " where not " & FindFieldC & " is null"
                        If Field_Type = 135 Then ZH_find = " where not " & FindFieldC & " is null"
                        If Field_Type = 2 Then ZH_find = " where not " & FindFieldC & " is null"
                        If Field_Type = 6 Then ZH_find = " where not " & FindFieldC & " is null"
                    Else
                        If Field_Type = 200 Then ZH_find = " where " & FindFieldC & " is null"
                        If Field_Type = 202 Then ZH_find = " where " & FindFieldC & " is null"
                        If Field_Type = 7 Then ZH_find = " where " & FindFieldC & " is null"
                        If Field_Type = 135 Then ZH_find = " where " & FindFieldC & " is null"
                        If Field_Type = 2 Then ZH_find = " where " & FindFieldC & " is null"
                        If Field_Type = 6 Then ZH_find = " where " & FindFieldC & " is null"
                    End If
                Else
                    If Me.Option6.Value Then
                        If Field_Type = 200 Then ZH_find = " where not " & FindFieldC & ZH_ysh & "'" & Field_Value & "' or " & FindFieldC & " is null"
                        If Field_Type = 202 Then ZH_find = " where not " & FindFieldC & ZH_ysh & "'" & Field_Value & "' or " & FindFieldC & " is null"
                        If Field_Type = 7 Then ZH_find = " where not " & FindFieldC & ZH_ysh & "#" & CDate(Field_Value) & "# or " & FindFieldC & " is null"
                        If Field_Type = 135 Then ZH_find = " where not " & FindFieldC & ZH_ysh & "#" & CDate(Field_Value) & "# or " & FindFieldC & " is null"
                        If Field_Type = 2 Then ZH_find = " where not " & FindFieldC & ZH_ysh & CInt(Field_Value) & " or " & FindFieldC & " is null"
                        If Field_Type = 6 Then ZH_find = " where not " & FindFieldC & ZH_ysh & CInt(Field_Value) & " or " & FindFieldC & " is null"
                    Else
                        If Field_Type = 200 Then ZH_find = " where " & FindFieldC & ZH_ysh & "'" & Field_Value & "'"
                        If Field_Type = 202 Then ZH_find = " where " & FindFieldC & ZH_ysh & "'" & Field_Value & "'"
                        If Field_Type = 7 Then ZH_find = " where " & FindFieldC & ZH_ysh & "#" & CDate(Field_Value) & "#"
                        If Field_Type = 135 Then ZH_find = " where " & FindFieldC & ZH_ysh & "#" & CDate(Field_Value) & "#"
                        If Field_Type = 2 Then ZH_find = " where " & FindFieldC & ZH_ysh & CInt(Field_Value)
                        If Field_Type = 6 Then ZH_find = " where " & FindFieldC & ZH_ysh & CInt(Field_Value)
                    End If
                End If
                End If
                MsgBox ZH_find
                FB_table2 = " 姓名,证件号码,证件名称,级别 from 客人资料 " & ZH_find
                US_Field = " 姓名,证件号码,证件名称,级别 from 客人资料 " & ZH_find
                MsgBox FB_table2
                Adodc1.CommandType = adCmdText
                Adodc1.RecordSource = "select " & FB_table2
                Adodc1.Refresh

                Set DataGrid1.DataSource = Adodc1
                DataGrid1.ReBind
                DataGrid1.Refresh
                'DataGrid1.Columns(0).Width = 1
                DataGrid1.Columns(2).Width = 800
                DataGrid1.Columns(3).Width = 500

                If Adodc1.Recordset.RecordCount = 0 Then
                    MsgBox "请注意:你所查找的用户不存在,请核对!", vbOKOnly, "错误信息"
                End If
            End If
            Exit Sub

ERR_pro201:
    MsgBox "请注意:查询错误,重新操作!", 48, "提示"

End Sub

Private Sub Command5_Click()
    Me.Picture1.Visible = False
End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    SFZ = Adodc1.Recordset.Fields("证件号码")
    FindFieldC = Adodc1.Recordset.Fields(DataGrid1.Col).Name
    Field_Type = CInt(Adodc1.Recordset.Fields(DataGrid1.Col).Type)
    
    Adodc2.ConnectionString = My_PROVIDER
    Adodc2.CommandType = adCmdText
    Adodc2.RecordSource = "select * from 住宿情况 where 证件号码 like '" & SFZ & "'"
    Adodc2.Refresh
    Set DataGrid2.DataSource = Adodc2
    DataGrid2.ReBind
    DataGrid2.Refresh
End Sub

Private Sub Form_Load()
    Left = 0
    Top = 0
    FindFieldC = "姓名"
    ZH_find = ""
    ZH_find1 = ""
    DJ_query = False
    ZH_ysh = " like "
    SF_BG = False
    BD_BG = False
    Or_Field = " 姓名"
    US_Field = ""
    
    Adodc1.ConnectionString = My_PROVIDER
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select 姓名,证件号码,证件名称,级别 from 客人资料"
    Adodc1.Refresh
    Set DataGrid1.DataSource = Adodc1
    DataGrid1.ReBind
    DataGrid1.Refresh
    'DataGrid1.Columns(0).Width = 1
    DataGrid1.Columns(2).Width = 800
    DataGrid1.Columns(3).Width = 500
    
    FB_table2 = " 姓名,证件号码,证件名称,级别 from 客人资料"
    US_Field = " 姓名,证件号码,证件名称,级别 from 客人资料"
    FB_table1 = FB_table2

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
    Dim i As Integer
    
    'On Error GoTo E3008
PE3008:
    Select Case Button.Key
        Case "关闭"
            Unload Me
        Case "全部"
            Adodc1.ConnectionString = My_PROVIDER
            Adodc1.CommandType = adCmdText
            Adodc1.RecordSource = "select * from " & FB_table1
            Adodc1.Refresh

        Case "查找"
            If FindFieldC = "" Then
                MsgBox "请注意:您未选择字段!", 48, "提示"
            Else
                Me.Picture1.Visible = True
                Me.Label13.Caption = FindFieldC
                Me.Field_Z.Text = ""
                Me.Field_Z.SetFocus
                If Not DJ_query Then
                    ZH_find1 = ""
                End If
            End If
            
        Case "多级查询"
            If Not DJ_query Then
                DJ_query = True
                Me.Toolbar1.Buttons(7).Value = tbrPressed
            Else
                DJ_query = False
                Me.Toolbar1.Buttons(7).Value = tbrUnpressed
            End If
    End Select
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -