📄 客史查询.frm
字号:
'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 + -