📄 frmmain.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmmain
BorderStyle = 1 'Fixed Single
Caption = "包厢同步 Ver : 0427"
ClientHeight = 4485
ClientLeft = 45
ClientTop = 330
ClientWidth = 6645
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmmain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4485
ScaleWidth = 6645
StartUpPosition = 2 '屏幕中心
Visible = 0 'False
Begin VB.CommandButton Command2
Caption = "清除歌曲目录"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4680
TabIndex = 6
Top = 600
Width = 1695
End
Begin VB.CheckBox Check1
Caption = "保存歌曲目录"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 120
TabIndex = 5
Top = 600
Value = 1 'Checked
Width = 2295
End
Begin VB.Timer Timer2
Interval = 5000
Left = 5760
Top = 4080
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 5000
Left = 5280
Top = 4080
End
Begin MSWinsockLib.Winsock ws
Left = 3240
Top = 600
_ExtentX = 741
_ExtentY = 741
_Version = 393216
Protocol = 1
End
Begin VB.ListBox List1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2790
Left = 120
TabIndex = 2
Top = 1080
Width = 6255
End
Begin VB.CommandButton Command1
Caption = "隐藏"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4680
TabIndex = 1
Top = 120
Width = 1695
End
Begin VB.PictureBox Picture1
AutoSize = -1 'True
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 540
Left = 5880
Picture = "frmmain.frx":030A
ScaleHeight = 480
ScaleWidth = 480
TabIndex = 0
Top = 5880
Visible = 0 'False
Width = 540
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Caption = "当前请求包厢:"
Height = 375
Left = 120
TabIndex = 4
Top = 120
Width = 2055
End
Begin VB.Label Label2
ForeColor = &H8000000D&
Height = 375
Left = 2280
TabIndex = 3
Top = 120
Width = 2175
End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As New ADODB.Recordset
Dim MinCos As Long, wineCos As Long, lServiceFee As Long
Dim total As Double
Dim prePos As Long
Dim userName As String
Dim pwd As String
Dim sTokens() As String
Dim ss
Dim st() As String
Dim pName As String
Dim num As Long
Dim price As Long
Dim pid As String
Dim strUnit As String
Dim str As String
Dim errPos As Long
Dim bt(1024) As Byte
Dim pos As Long
Dim a As String
Dim strWine As String
Dim i As Long
Dim RoomName As String
Dim typeName As String
Dim typeid As Long
Private Sub Command1_Click()
If (Icon_Add(frmmain.hwnd, Picture1.Picture)) Then
frmmain.Hide
lproc = SetWindowLong(frmmain.hwnd, GWL_WNDPROC, AddressOf DialogProc)
End If
End Sub
Private Sub Command2_Click()
On Error GoTo errdel
cnn.Execute "delete from SongList"
MsgBox "清除完毕。", vbInformation
Exit Sub
errdel:
MsgBox err.Description
End Sub
Private Sub Form_Load()
On Error GoTo errdeal
ws.Bind 7912, ws.LocalIP
Timer1_Timer
Command1_Click
Exit Sub
errdeal:
MsgBox err.Description, vbInformation
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("你确定要退出 '包厢同步' 吗？" & vbCrLf & "这样将导致包厢状态异常。", vbOKCancel Or vbInformation) = vbOK Then
If cnn.State = adStateOpen Then
cnn.Close
Set cnn = Nothing
End If
End
Else
Command1_Click
End If
End Sub
Private Sub Label3_DblClick()
On Error Resume Next
cnn.Execute "create table SongList (sn int,RoomName text(20), SongName text(128))"
End Sub
Private Sub Timer1_Timer()
On Error GoTo errdeal
If CleanAfterClose = 0 Then
cnn.Execute "update roominfo set user_flag=0 where user_flag=2 and endtime<=now"
ElseIf CleanAfterClose = 1 Then
cnn.Execute "update roominfo set user_flag=-2 where user_flag=2 and endtime<=now"
End If
If iClearInterval = 0 Then
cnn.Execute "update roominfo as a,roominfo1 as b set b.stat='0' where a.room_id =b.rno and (a.user_flag=-3 or a.user_flag=-2 or a.user_flag=-1 or a.user_flag=0)"
cnn.Execute "update roominfo as a,roominfo1 as b set b.stat='1' where a.room_id =b.rno and (a.user_flag=3 or a.user_flag=2 or a.user_flag=1 or a.user_flag=-4)"
End If
Exit Sub
errdeal:
Beep
Label2.Caption = "网络不通"
End Sub
Private Sub Timer2_Timer()
If iClearInterval = 0 Then Exit Sub
On Error GoTo errdeal
ws.Close
ws.Bind 7912, ws.LocalIP
List1.Clear
Exit Sub
errdeal:
MsgBox err.Description, vbInformation
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
On Error GoTo errdeal
Dim Fst As Long, Scd As Long
Dim userNumber As String, pwd As String, songs As String
Dim dp As Long
ws.GetData str, vbString, 4096
Fst = Asc(Left$(str, 1))
Scd = Asc(Mid$(str, 2, 1))
If Fst = 13 Then
Select Case Scd
Case 22
bt(0) = 13
bt(1) = 22
pos = 2
sTokens = Split(str, ",")
RoomName = sTokens(1)
Label2.Caption = RoomName
If rs.State = adStateOpen Then rs.Close
rs.Open "select * from roominfo where room_number='" & RoomName & "'", cnn, adOpenDynamic, adLockOptimistic
If rs.EOF Then
strWine = "房态=开房;开房=1;预定=2;点歌=0;播放=0;轮播=1;服务=0;点酒水=0;查帐单=0;贵宾=0;清台=10;"
For i = 1 To Len(strWine)
a = Hex(Asc(Mid$(strWine, i, 1)))
If Len(a) > 2 Then
bt(pos) = "&H" & Mid$(a, 1, 2)
pos = pos + 1
bt(pos) = "&H" & Mid$(a, 3, 2)
pos = pos + 1
Else
bt(pos) = "&H" & a
pos = pos + 1
End If
Next
bt(pos) = 0
ws.SendData bt
Else
If Val("0" & rs!user_flag) > 0 Or Val(rs!user_flag) = -4 Then
strWine = "房态=开房;开房=1;预定=2;点歌=0;播放=0;轮播=1;服务=0;点酒水=0;查帐单=0;贵宾=0;清台=10;"
For i = 1 To Len(strWine)
a = Hex(Asc(Mid$(strWine, i, 1)))
If Len(a) > 2 Then
bt(pos) = "&H" & Mid$(a, 1, 2)
pos = pos + 1
bt(pos) = "&H" & Mid$(a, 3, 2)
pos = pos + 1
Else
bt(pos) = "&H" & a
pos = pos + 1
End If
Next
bt(pos) = 0
ws.SendData bt
Else
strWine = "房态=关房;开房=0;预定=12;点歌=1;播放=1;轮播=0;服务=6;点酒水=7;查帐单=8;贵宾=9;清台=20;"
For i = 1 To Len(strWine)
a = Hex(Asc(Mid$(strWine, i, 1)))
If Len(a) > 2 Then
bt(pos) = "&H" & Mid$(a, 1, 2)
pos = pos + 1
bt(pos) = "&H" & Mid$(a, 3, 2)
pos = pos + 1
Else
bt(pos) = "&H" & a
pos = pos + 1
End If
Next
bt(pos) = 0
ws.SendData bt
bt(0) = 12
bt(1) = 3
pos = 2
strWine = RoomName
For i = 1 To Len(strWine)
a = Hex(Asc(Mid$(strWine, i, 1)))
If Len(a) > 2 Then
bt(pos) = "&H" & Mid$(a, 1, 2)
pos = pos + 1
bt(pos) = "&H" & Mid$(a, 3, 2)
pos = pos + 1
Else
bt(pos) = "&H" & a
pos = pos + 1
End If
Next
bt(pos) = 0
ws.SendData bt
End If
End If
If rs.State = adStateOpen Then rs.Close
On Error Resume Next
rs.Open "select * from gbinfo where RoomName='" & RoomName & "'", cnn, adOpenDynamic, adLockOptimistic
If Not rs.EOF Then
bt(0) = 11
bt(1) = 5
pos = 2
strWine = "走马灯," & rs!gb_text
rs.Delete
rs.Update
For i = 1 To Len(strWine)
a = Hex(Asc(Mid$(strWine, i, 1)))
If Len(a) > 2 Then
bt(pos) = "&H" & Mid$(a, 1, 2)
pos = pos + 1
bt(pos) = "&H" & Mid$(a, 3, 2)
pos = pos + 1
Else
bt(pos) = "&H" & a
pos = pos + 1
End If
Next
bt(pos) = 0
ws.SendData bt
cnn.Execute "delete from gbinfo where RoomName='" & RoomName & "'"
End If
If rs.State = adStateOpen Then rs.Close
Exit Sub
Case 2
For i = 3 To Len(str)
If Asc(Mid$(str, i, 1)) = 0 Then
RoomName = Mid$(str, 3, i - 3)
Exit For
End If
Next
cnn.Execute "update roominfo set callfu=true where room_number='" & RoomName & "'"
Case 9
For i = 3 To Len(str)
If Asc(Mid$(str, i, 1)) = 0 Then
RoomName = Mid$(str, 3, i - 3)
Exit For
End If
Next
cnn.Execute "update roominfo set callfu=false where room_number='" & RoomName & "'"
Case 8
prePos = 3
For i = prePos To Len(str)
If Mid$(str, i, 1) = "," Then
RoomName = Mid$(str, 3, i - prePos)
prePos = i + 1
Exit For
End If
Next
For i = prePos To Len(str)
If Mid$(str, i, 1) = "," Then
userName = Mid$(str, prePos, i - prePos)
prePos = i + 1
Exit For
End If
Next
pwd = Mid$(str, prePos, 3)
For i = 1 To Len(pwd)
If Asc(Mid(pwd, i, 1)) = 0 Then
pwd = Left(pwd, i - 1)
Exit For
End If
Next
If rs.State = adStateOpen Then rs.Close
rs.Open "select * from users where (user_id='" & userName & "' and left(user_pass,3)='" & pwd & "')", cnn, adOpenDynamic, adLockOptimistic
If Not rs.EOF Then
cnn.Execute "update roominfo set user_flag =0 where room_number='" & RoomName & "' and user_flag=-2"
bt(0) = 12
bt(1) = 6
bt(2) = 1
bt(3) = 0
ws.SendData bt
Else
bt(0) = 12
bt(1) = 6
bt(2) = 0
bt(3) = 0
ws.SendData bt
End If
If rs.State = adStateOpen Then rs.Close
Case 3 ' 请求物品类别
bt(0) = 13
bt(1) = 3
pos = 2
If rs.State = adStateOpen Then rs.Close
rs.Open "select * from product_type", cnn, adOpenDynamic, adLockOptimistic
strWine = ""
While Not rs.EOF
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -