📄 frmmain.frm
字号:
VERSION 5.00
Object = "{24F6B197-1E6D-11D3-89E6-00A0C932F831}#172.0#0"; "wsipx32.ocx"
Begin VB.Form frmmain
BorderStyle = 1 'Fixed Single
Caption = "仿真服务"
ClientHeight = 3390
ClientLeft = 45
ClientTop = 330
ClientWidth = 6045
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 = 3390
ScaleWidth = 6045
StartUpPosition = 2 '屏幕中心
Visible = 0 'False
Begin VB.CommandButton Command3
Caption = "刷新"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2400
TabIndex = 4
Top = 2760
Width = 1095
End
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 = 4320
TabIndex = 2
Top = 2760
Width = 1095
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 = 600
TabIndex = 1
Top = 2760
Width = 1095
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 = 2040
Picture = "frmmain.frx":0CCA
ScaleHeight = 480
ScaleWidth = 480
TabIndex = 0
Top = 4440
Visible = 0 'False
Width = 540
End
Begin VB.Timer Timer1
Interval = 5000
Left = 840
Top = 4440
End
Begin wsipx32x.wsipx wsipx1
Left = 120
Tag = "00fd00000458,00902737442f"
Top = 4440
_ExtentX = 873
_ExtentY = 873
Node = "ffffffffffff"
Network = "00000001"
SendSocket = "5555"
RecvSocket = "5555"
End
Begin VB.Label Label2
Alignment = 2 'Center
Caption = "工作正常"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1335
Left = 120
TabIndex = 5
Top = 1080
Width = 5775
End
Begin VB.Label Label1
Caption = "注意：在“吧台管理”运行期间，请不要 将“仿真服务”关闭！ 版本号：Ver 5.01"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 735
Left = 960
TabIndex = 3
Top = 120
Width = 3975
WordWrap = -1 'True
End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public timerextend As Integer
Dim strSQL As String
Dim RECVDATA(0 To 255) As Byte
Private Sub Command1_Click()
Dim l As Long
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()
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 Command3_Click()
On Error GoTo errdeel
cnn.Execute "update roominfo1 set stat = '1'"
MsgBox "刷新完成，网络连接正常。", vbInformation
Exit Sub
errdeel:
MsgBox "刷新失败,请确认是以sys用户登录计算机，且网络连接正常。", vbExclamation
End Sub
Private Sub Form_Load()
wsipx1.Enabled = True
wsipx1.Enable_Events True
Label2.Caption = "工作正常"
Label2.FontSize = 35
Label2.ForeColor = 3977016
Timer1_Timer
Command1_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
If cnn.State = adStateOpen Then
cnn.Close
End If
Set cnn = Nothing
End Sub
Private Sub Label1_Click()
Dim strMSG As String
strMSG = ""
strMSG = strMSG & "FreshInterval=5 刷新间隔" & Chr(13)
strMSG = strMSG & "autozl=0 自动转整理" & Chr(13)
strMSG = strMSG & "bOrg=1 是否使用原来的呼叫模式" & Chr(13)
strMSG = strMSG & "bSyn=1 是否跟网络服务器的时间同步" & Chr(13)
strMSG = strMSG & "strCompact1=“” 压缩数据库的路径 1" & Chr(13)
strMSG = strMSG & "strCompact2=“” 压缩数据库的路径 2" & Chr(13)
MsgBox strMSG
End Sub
Private Sub Label2_Click()
Label2.Caption = ""
End Sub
Private Sub Timer1_Timer()
On Error GoTo errdeal
If autozl = False Then
strSQL = "update roominfo set user_flag=0 where user_flag=2 and starttime<=now"
cnn.Execute strSQL
Else
strSQL = "update roominfo set user_flag=-2 where user_flag=2 and starttime<=now"
cnn.Execute strSQL
End If
strSQL = "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 strSQL
strSQL = "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)"
cnn.Execute strSQL
Label2.Caption = "工作正常"
Label2.FontSize = 35
Label2.ForeColor = 3977016
Exit Sub
errdeal:
Beep
Label2.Caption = strSQL
Label2.FontSize = 12
Label2.ForeColor = 255
End Sub
Private Sub wsipx1_receive()
If bOrg = False Then Exit Sub 'False表示不用原来的呼叫处理方式
'true表示用原来的，就继续
On Error Resume Next
Call wsipx1.Get_recv_data_bin(RECVDATA)
If RECVDATA(0) = RECVDATA(2) Then
If RECVDATA(0) = &H80 Then
cnn.Execute "UPDATE roominfo SET callfu=true WHERE room_id=" & RECVDATA(1)
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -