www.pudn.com > netserver.zip > frmMain.frm
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMain
Caption = "网吧记费器——用户："
ClientHeight = 6285
ClientLeft = 165
ClientTop = 450
ClientWidth = 9255
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6285
ScaleWidth = 9255
StartUpPosition = 2 '屏幕中心
WindowState = 2 'Maximized
Begin VB.Data Data11
Caption = "Data11"
Connect = "Access 2000;"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 375
Left = 4560
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 1800
Visible = 0 'False
Width = 1815
End
Begin VB.Data Data10
Caption = "Data10"
Connect = "Access 2000;"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 285
Left = 2520
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 1800
Visible = 0 'False
Width = 1860
End
Begin VB.Data Data9
Caption = "Data9"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 6600
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 1440
Visible = 0 'False
Width = 1740
End
Begin MSComctlLib.ImageList ImageList2
Left = 1680
Top = 2160
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":0442
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":0894
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":0CE6
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":1138
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":1452
Key = ""
EndProperty
EndProperty
End
Begin MSComDlg.CommonDialog ComDlg
Left = 360
Top = 2280
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Timer Timer1
Interval = 1000
Left = 3840
Top = 2400
End
Begin VB.Timer Timer2
Interval = 30000
Left = 2400
Top = 2280
End
Begin MSWinsockLib.Winsock Winsock2
Left = 1200
Top = 2280
_ExtentX = 741
_ExtentY = 741
_Version = 393216
LocalPort = 14914
End
Begin MSWinsockLib.Winsock Winsock1
Index = 0
Left = 2760
Top = 2400
_ExtentX = 741
_ExtentY = 741
_Version = 393216
LocalPort = 14914
End
Begin MSComctlLib.ImageList ImageList1
Left = 600
Top = 1560
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":176C
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":1BBE
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":2010
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":2462
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":277C
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 0
Top = 5910
Width = 9255
_ExtentX = 16325
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 6456
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 4304
MinWidth = 4304
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 5010
MinWidth = 5010
EndProperty
EndProperty
End
Begin VB.Data Data8
Caption = "Data8"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 285
Left = 6600
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 1080
Visible = 0 'False
Width = 1815
End
Begin VB.Data Data7
Caption = "Data7"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 285
Left = 6600
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 720
Visible = 0 'False
Width = 1815
End
Begin VB.Data Data6
Caption = "Data6"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 405
Left = 4560
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 1440
Visible = 0 'False
Width = 1815
End
Begin VB.Data Data5
Caption = "Data5"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 285
Left = 4560
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 1080
Visible = 0 'False
Width = 1815
End
Begin VB.Data Data4
Caption = "Data4"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 315
Left = 4560
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 720
Visible = 0 'False
Width = 1815
End
Begin VB.Data Data3
Caption = "Data3"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 2520
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 1440
Visible = 0 'False
Width = 1860
End
Begin VB.Data Data2
Caption = "Data2"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 2520
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 1080
Visible = 0 'False
Width = 1860
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 2520
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 720
Visible = 0 'False
Width = 1860
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 570
Left = 0
TabIndex = 2
Top = 0
Width = 9255
_ExtentX = 16325
_ExtentY = 1005
ButtonWidth = 820
ButtonHeight = 953
Appearance = 1
Style = 1
ImageList = "imlToolbarIcons"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 6
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "记费"
Key = "记费"
ImageKey = "MAIL17"
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "结帐"
Key = "结帐"
ImageKey = "W95MBX01"
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "统计"
Key = "统计"
ImageKey = "GRAPH07"
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "查看"
Key = "查看"
ImageKey = "MSGBOX02"
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "帮助"
Key = "帮助"
Object.ToolTipText = "帮助"
ImageKey = "Help"
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList imlToolbarIcons
Left = 4020
Top = 2895
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":2A96
Key = "W95MBX01"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":2DB0
Key = "GRAPH07"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":30CA
Key = "MAIL17"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":33E4
Key = "MSGBOX02"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":36FE
Key = "Help"
EndProperty
EndProperty
End
Begin MSComctlLib.ListView ListView1
Height = 3975
Left = 0
TabIndex = 1
Top = 600
Width = 8295
_ExtentX = 14631
_ExtentY = 7011
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
Icons = "ImageList2"
SmallIcons = "ImageList1"
ColHdrIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
MousePointer = 1
NumItems = 9
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "机号"
Object.Width = 1658
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "开机时间"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "到点时间"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "已用时间"
Object.Width = 1656
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "单价"
Object.Width = 1304
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Text = "金额"
Object.Width = 1906
EndProperty
BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 6
Text = "其他费用"
Object.Width = 1658
EndProperty
BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 7
Text = "总金额"
Object.Width = 1906
EndProperty
BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 8
Text = "用户"
Object.Width = 2540
EndProperty
End
Begin VB.Menu cd1
Caption = "系统(&S)"
Begin VB.Menu cd11
Caption = "计算机设置"
End
Begin VB.Menu cd12
Caption = "管理员设置"
End
Begin VB.Menu cd01
Caption = "-"
End
Begin VB.Menu cd13
Caption = "数据备份"
End
Begin VB.Menu cd14
Caption = "数据还原"
End
Begin VB.Menu cd02
Caption = "-"
End
Begin VB.Menu cd16
Caption = "系统设置"
End
Begin VB.Menu cd03
Caption = "-"
End
Begin VB.Menu cd18
Caption = "以其他用户登陆"
End
Begin VB.Menu cd19
Caption = "锁定桌面"
End
Begin VB.Menu cd104
Caption = "-"
End
Begin VB.Menu cd17
Caption = "退出"
End
End
Begin VB.Menu cdJF
Caption = "记费(&M)"
Begin VB.Menu cdJF1
Caption = "开始记费"
End
Begin VB.Menu cdJF2
Caption = "限定时间"
End
Begin VB.Menu cdJF01
Caption = "-"
End
Begin VB.Menu cdJF3
Caption = "结帐"
End
Begin VB.Menu cdJF03
Caption = "-"
End
Begin VB.Menu cdJF4
Caption = "调换计算机"
End
Begin VB.Menu cdJF5
Caption = "选购商品"
End
Begin VB.Menu cdJF02
Caption = "-"
End
Begin VB.Menu cdJF6
Caption = "查看当前机程序"
End
Begin VB.Menu cdJF7
Caption = "客户机控制"
End
End
Begin VB.Menu cdView
Caption = "查看(&V)"
Begin VB.Menu cdView1
Caption = "大图标"
End
Begin VB.Menu cdView2
Caption = "小图标"
End
Begin VB.Menu cdView3
Caption = "列表"
End
Begin VB.Menu cdView4
Caption = "详细资料"
Checked = -1 'True
End
Begin VB.Menu cdView01
Caption = "-"
End
Begin VB.Menu cdView5
Caption = "刷新"
Shortcut = {F5}
End
Begin VB.Menu cdView6
Caption = "显示网格"
Checked = -1 'True
End
Begin VB.Menu cdView7
Caption = "字体"
End
Begin VB.Menu cdView8
Caption = "背景图片"
End
Begin VB.Menu cdView9
Caption = "背影颜色"
End
Begin VB.Menu cdView10
Caption = "还原为默认"
End
End
Begin VB.Menu cdGL
Caption = "管理(&G)"
Begin VB.Menu cdGL1
Caption = "商品资料管理"
End
Begin VB.Menu cdGL2
Caption = "客户管理"
End
Begin VB.Menu cdGL3
Caption = "储金卡管理"
End
Begin VB.Menu cdGL4
Caption = "快速网址"
End
Begin VB.Menu cdGL5
Caption = "访问限制"
End
End
Begin VB.Menu cdTJ
Caption = "统计(&P)"
Begin VB.Menu cdTJ1
Caption = "日报表"
Begin VB.Menu cdTJ11
Caption = "机时收费表"
End
Begin VB.Menu cdTJ12
Caption = "商品销售统计表"
End
Begin VB.Menu cdTJ13
Caption = "收入统计表"
End
End
Begin VB.Menu cdTJ2
Caption = "月报表"
Begin VB.Menu cdTJ21
Caption = "机时收费表"
End
Begin VB.Menu cdTJ22
Caption = "商品销售统计表"
End
Begin VB.Menu cdTJ23
Caption = "收入统计表"
End
End
End
Begin VB.Menu cdHelp
Caption = "帮助(&H)"
Begin VB.Menu cdHelp1
Caption = "联机帮助"
End
Begin VB.Menu cdHelp01
Caption = "-"
End
Begin VB.Menu cdHelpAbout
Caption = "关于..."
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cdJF1_Click()
frmStart.Command8.Enabled = True
frmStart.cmdOpen.Enabled = True
frmStart.Command12.Enabled = False
frmStart.Caption = ListView1.SelectedItem.Text + "->开始记费？"
'frmStart.Visible = True
frmStart.Show vbModal, Me
End Sub
Private Sub cdJF2_Click()
frmStart.Command8.Enabled = False
frmStart.cmdOpen.Enabled = False
frmStart.Command12.Enabled = True
frmStart.Caption = ListView1.SelectedItem.Text + "->重新设定开机？"
frmStart.Show vbModal, Me
End Sub
Private Sub cdJF3_Click()
Load frmEndPlay
frmEndPlay.Caption = ListView1.SelectedItem.Text + "->要结帐？"
frmEndPlay.Show vbModal, Me
End Sub
Private Sub cdJF4_Click()
frmChangeJSJ.Show vbModal, Me
End Sub
Private Sub cdJF5_Click()
frmShangPin.Show vbModal, Me
End Sub
Private Sub cdJF6_Click()
On Error Resume Next
'cmdOpen_Click
For i = 0 To Winsock1.Count - 1
If Data1.Recordset.Fields("IP") = Winsock1(i).RemoteHostIP Then
frmComputer.SelectComIndex = i
frmMain.Winsock1(i).SendData "_prog" + Chr(0) + "get" + Chr(0) + "OK$"
DoEvents
Exit For
End If
Next i
frmComputer.Show
End Sub
Private Sub cdJF7_Click()
'客户机控制
frmManager.Show vbModal, Me
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
Select Case Button.Key
Case "帮助"
'应做:添加 '帮助' 按钮代码。
cdHelp1_Click
Case "查看"
'应做:添加 '查看' 按钮代码。
PopupMenu cdView
Case "记费"
'应做:添加 '记费' 按钮代码。
cdJF1_Click
Case "结帐"
'应做:添加 '结帐' 按钮代码。
cdJF3_Click
Case "统计"
'应做:添加 '统计' 按钮代码。
PopupMenu cdTJ
End Select
End Sub
Private Sub cd11_Click()
frmJSJ.Show vbModal, Me
End Sub
Private Sub cd12_Click()
frmAdmin.Show vbModal, Me
End Sub
Private Sub cd13_Click()
'备份数据
On Error Resume Next
ComDlg.CancelError = True
ComDlg.FileName = Format(Date, "yyyymmdd") & ".bak"
ComDlg.Filter = "备份文件|*.bak"
ComDlg.ShowSave
If Err <> mscomdlg.cdlCancel Then
'MsgBox Dir(ComDlg.FileName) = ""
If Dir(ComDlg.FileName) <> "" Then
If MsgBox("当前日期已经备份了，确实要再次备份吗？", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
pd = CopyFile(App.Path & "\dbase.mdb", ComDlg.FileName, 0)
If pd = 0 Then
MsgBox "发现错误备份失败！", vbCritical, "错误"
Else
MsgBox "备份成功！", vbQuestion, "好消息"
End If
End If
End Sub
Private Sub cd14_Click()
'数据还原
On Error Resume Next
ComDlg.CancelError = True
'ComDlg.FileName = Format(Date, "yyyymmdd") & ".bak"
ComDlg.Filter = "备份文件|*.bak"
ComDlg.ShowOpen
If Err <> mscomdlg.cdlCancel Then
If MsgBox("请您确认“" & ComDlg.FileName & "”是您以前备份的文件，否则可能出现不可想像的错误。如果发生了错误，请你参见联机帮助的解决办法，建议您先对当前数据库进行备份。而且还原后，在您备份以后的数据都将丢失。您真的要还原这个数据库吗？", _
vbYesNo + vbQuestion + vbDefaultButton2, "问题") = vbNo Then Exit Sub
'关闭所有数据库
Data1.Database.Close
Data2.Database.Close
Data3.Database.Close
Data4.Database.Close
Data5.Database.Close
Data6.Database.Close
Data7.Database.Close
Data8.Database.Close
Data9.Database.Close
FileCopy ComDlg.FileName, App.Path & "\dbase.mdb"
If Err <> 0 Then
MsgBox "发现错误：" & Error$, vbCritical, "错误"
Else
MsgBox "还原成功！请您点击确定，将使用这个数据库。如果发生了错误，请您参见联机帮助的解决办法。", vbExclamation, "注意"
End If
Me.Visible = False
Form_Load
Me.Visible = True
End If
End Sub
Private Sub cd16_Click()
frmOptions.Show vbModal, Me
End Sub
Private Sub cd17_Click()
Unload Me
End Sub
Private Sub cd18_Click()
Longin
End Sub
Private Sub cd19_Click()
frmScreen.Show
End Sub
Private Sub cdGL1_Click()
frmGood.Show , Me
End Sub
Private Sub cdGL2_Click()
'客户管理
frmKeHuGL.Show
End Sub
Private Sub cdGL3_Click()
frmCJKGL.Show
End Sub
Private Sub cdGL4_Click()
frmQuickHttp.Show
End Sub
Private Sub cdGL5_Click()
frmHickHttp.Show
End Sub
Private Sub cdHelp1_Click()
ShellExecute 0, "open", SystemPath & App.HelpFile, "", "", 1
End Sub
Private Sub cdHelpAbout_Click()
frmAbout.Show vbModal, Me
End Sub
Private Sub cdTJ11_Click()
frmBiaoBiao.Show , Me
frmBiaoBiao.Combo1.Text = cdTJ11.Caption
frmBiaoBiao.DTP1.Value = Date
frmBiaoBiao.DTP2.Value = Date
frmBiaoBiao.DTP1.Hour = 0
frmBiaoBiao.DTP1.Minute = 0
frmBiaoBiao.DTP1.Second = 0
frmBiaoBiao.DTP2.Hour = 23
frmBiaoBiao.DTP2.Minute = 59
frmBiaoBiao.DTP2.Second = 59
End Sub
Private Sub cdTJ12_Click()
frmBiaoBiao.Show , Me
frmBiaoBiao.Combo1.Text = cdTJ12.Caption
frmBiaoBiao.DTP1.Value = Date
frmBiaoBiao.DTP2.Value = Date
frmBiaoBiao.DTP1.Hour = 0
frmBiaoBiao.DTP1.Minute = 0
frmBiaoBiao.DTP1.Second = 0
frmBiaoBiao.DTP2.Hour = 23
frmBiaoBiao.DTP2.Minute = 59
frmBiaoBiao.DTP2.Second = 59
End Sub
Private Sub cdTJ13_Click()
frmBiaoBiao.Show , Me
frmBiaoBiao.Combo1.Text = cdTJ13.Caption
frmBiaoBiao.DTP1.Value = Date
frmBiaoBiao.DTP2.Value = Date
frmBiaoBiao.DTP1.Hour = 0
frmBiaoBiao.DTP1.Minute = 0
frmBiaoBiao.DTP1.Second = 0
frmBiaoBiao.DTP2.Hour = 23
frmBiaoBiao.DTP2.Minute = 59
frmBiaoBiao.DTP2.Second = 59
End Sub
Private Sub cdTJ21_Click()
frmBiaoBiao.Show , Me
frmBiaoBiao.Combo1.Text = cdTJ21.Caption
frmBiaoBiao.DTP1.Year = Year(Date)
frmBiaoBiao.DTP1.Day = Abs(Data7.Recordset.Fields("每月开始时间"))
frmBiaoBiao.DTP2.Year = Year(Date)
frmBiaoBiao.DTP2.Day = Abs(Data7.Recordset.Fields("每月结束时间"))
If Data7.Recordset.Fields("每月开始时间") < 0 Then
If Month(Date) = 1 Then
frmBiaoBiao.DTP1.Month = 12
frmBiaoBiao.DTP1.Year = Year(Date) - 1
Else
frmBiaoBiao.DTP1.Month = Month(Date) - 1
End If
Else
frmBiaoBiao.DTP1.Month = Month(Date)
End If
If Data7.Recordset.Fields("每月结束时间") < 0 Then
If Month(Date) = 12 Then
frmBiaoBiao.DTP2.Month = 1
frmBiaoBiao.DTP2.Year = Year(Date) + 1
Else
frmBiaoBiao.DTP2.Month = Month(Date) + 1
End If
Else
frmBiaoBiao.DTP2.Month = Month(Date)
End If
frmBiaoBiao.DTP1.Hour = 0
frmBiaoBiao.DTP1.Minute = 0
frmBiaoBiao.DTP1.Second = 0
frmBiaoBiao.DTP2.Hour = 23
frmBiaoBiao.DTP2.Minute = 59
frmBiaoBiao.DTP2.Second = 59
End Sub
Private Sub cdTJ22_Click()
frmBiaoBiao.Show , Me
frmBiaoBiao.Combo1.Text = cdTJ22.Caption
frmBiaoBiao.DTP1.Year = Year(Date)
frmBiaoBiao.DTP1.Day = Abs(Data7.Recordset.Fields("每月开始时间"))
frmBiaoBiao.DTP2.Year = Year(Date)
frmBiaoBiao.DTP2.Day = Abs(Data7.Recordset.Fields("每月结束时间"))
If Data7.Recordset.Fields("每月开始时间") < 0 Then
If Month(Date) = 1 Then
frmBiaoBiao.DTP1.Month = 12
frmBiaoBiao.DTP1.Year = Year(Date) - 1
Else
frmBiaoBiao.DTP1.Month = Month(Date) - 1
End If
Else
frmBiaoBiao.DTP1.Month = Month(Date)
End If
If Data7.Recordset.Fields("每月结束时间") < 0 Then
If Month(Date) = 12 Then
frmBiaoBiao.DTP2.Month = 1
frmBiaoBiao.DTP2.Year = Year(Date) + 1
Else
frmBiaoBiao.DTP2.Month = Month(Date) + 1
End If
Else
frmBiaoBiao.DTP2.Month = Month(Date)
End If
frmBiaoBiao.DTP1.Hour = 0
frmBiaoBiao.DTP1.Minute = 0
frmBiaoBiao.DTP1.Second = 0
frmBiaoBiao.DTP2.Hour = 23
frmBiaoBiao.DTP2.Minute = 59
frmBiaoBiao.DTP2.Second = 59
End Sub
Private Sub cdTJ23_Click()
frmBiaoBiao.Show , Me
frmBiaoBiao.Combo1.Text = cdTJ23.Caption
frmBiaoBiao.DTP1.Year = Year(Date)
frmBiaoBiao.DTP1.Day = Abs(Data7.Recordset.Fields("每月开始时间"))
frmBiaoBiao.DTP2.Year = Year(Date)
frmBiaoBiao.DTP2.Day = Abs(Data7.Recordset.Fields("每月结束时间"))
If Data7.Recordset.Fields("每月开始时间") < 0 Then
If Month(Date) = 1 Then
frmBiaoBiao.DTP1.Month = 12
frmBiaoBiao.DTP1.Year = Year(Date) - 1
Else
frmBiaoBiao.DTP1.Month = Month(Date) - 1
End If
Else
frmBiaoBiao.DTP1.Month = Month(Date)
End If
If Data7.Recordset.Fields("每月结束时间") < 0 Then
If Month(Date) = 12 Then
frmBiaoBiao.DTP2.Month = 1
frmBiaoBiao.DTP2.Year = Year(Date) + 1
Else
frmBiaoBiao.DTP2.Month = Month(Date) + 1
End If
Else
frmBiaoBiao.DTP2.Month = Month(Date)
End If
frmBiaoBiao.DTP1.Hour = 0
frmBiaoBiao.DTP1.Minute = 0
frmBiaoBiao.DTP1.Second = 0
frmBiaoBiao.DTP2.Hour = 23
frmBiaoBiao.DTP2.Minute = 59
frmBiaoBiao.DTP2.Second = 59
End Sub
Private Sub cdView1_Click()
ListView1.View = lvwIcon
cdView1.Checked = True
cdView2.Checked = False
cdView3.Checked = False
cdView4.Checked = False
End Sub
Private Sub cdView10_Click()
'还原为默认
LoadShow True
End Sub
Private Sub cdView2_Click()
ListView1.View = lvwSmallIcon
cdView1.Checked = False
cdView2.Checked = True
cdView3.Checked = False
cdView4.Checked = False
End Sub
Private Sub cdView3_Click()
ListView1.View = lvwList
cdView1.Checked = False
cdView2.Checked = False
cdView3.Checked = True
cdView4.Checked = False
End Sub
Private Sub cdView4_Click()
ListView1.View = lvwReport
cdView1.Checked = False
cdView2.Checked = False
cdView3.Checked = False
cdView4.Checked = True
End Sub
Private Sub cdView5_Click()
'ListView1.SortKey = Index
'ListView1.Sorted = True
'ListView1.Refresh
Timer2_Timer
End Sub
Private Sub cdView6_Click()
cdView6.Checked = IIf(cdView6.Checked, fals, True)
ListView1.GridLines = cdView6.Checked
End Sub
Private Sub cdView7_Click()
'设置字体
On Error Resume Next
ComDlg.CancelError = True
ComDlg.Flags = 3 Or &H100
ComDlg.FontSize = ListView1.Font.Size
ComDlg.FontItalic = ListView1.Font.Italic
ComDlg.FontBold = ListView1.Font.Bold
ComDlg.FontName = ListView1.Font.Name
ComDlg.Color = ListView1.ForeColor
ComDlg.ShowFont
If Err = 0 Then
ListView1.Font.Size = ComDlg.FontSize
ListView1.Font.Italic = ComDlg.FontItalic
ListView1.Font.Bold = ComDlg.FontBold
ListView1.Font.Name = ComDlg.FontName
ListView1.ForeColor = ComDlg.Color
With Data8.Recordset
.MoveFirst
For i = 1 To .RecordCount
If .Fields("用户名称") = UserName Then
.Edit
.Fields("字体") = ComDlg.FontName
.Fields("字号") = ComDlg.FontSize
.Fields("字体颜色") = ComDlg.Color
.Fields("粗体") = ComDlg.FontBold
.Fields("斜体") = ComDlg.FontItalic
.Update
Exit Sub
End If
.MoveNext
Next i
End With
End If
End Sub
Private Sub cdView8_Click()
'设置图片
On Error Resume Next
ComDlg.Filter = "所有图型文件|*.dib;*.bmp;*.wmf;*.emf;*.gif;*.jpg|" & _
"位图文件(*.bmp,*.dib)|*.bmp;*.dib|" & _
"GIF图像(*.gif)|*.gif|" & _
"JPEG图像(*.jpg)|*.jpg|" & _
"元文件(*.wmf,*.emf)|*.wmf;*.emf|" & _
"图标文件(*.ico,*.cur|*.ico;*.cur|"
ComDlg.ShowOpen
If Err = 0 Then
ListView1.Picture = LoadPicture(ComDlg.FileName)
If Err = 0 Then
With Data8.Recordset
.MoveFirst
For i = 1 To .RecordCount
If .Fields("用户名称") = UserName Then
.Edit
.Fields("背景") = ComDlg.FileName
.Update
Exit Sub
End If
' MsgBox .Fields("背景")
.MoveNext
Next i
End With
Else
MsgBox Error, vbCritical
End If
End If
End Sub
Private Sub cdView9_Click()
'背景颜色
On Error Resume Next
With ComDlg
.CancelError = True
.Flags = 2 Or 1
.Color = ListView1.BackColor
.ShowColor
If Err = 0 Then
ListView1.BackColor = .Color
End If
End With
With Data8.Recordset
.MoveFirst
For i = 1 To .RecordCount
If .Fields("用户名称") = UserName Then
.Edit
.Fields("背景颜色") = ComDlg.Color
.Update
Exit Sub
End If
.MoveNext
Next i
End With
End Sub
Private Sub Form_Load()
On Error Resume Next
If App.PrevInstance = True Then End
SystemPath = App.Path
If Right(SystemPath, 1) <> "\" Then SystemPath = SystemPath + "\"
'MsgBox SupperMsgbox("ASFDF", vbYesNo, "asd")
Image2.Top = 4095
Data1.DatabaseName = SystemPath + "dbase.mdb" '机时表
Data1.Connect = ";pwd=123456"
Data1.RecordSource = "yxsjb"
Data1.Refresh
Data1.Recordset.MoveLast
Data1.Recordset.MoveFirst
Data2.DatabaseName = SystemPath + "dbase.mdb" '商品临时记录表
Data2.Connect = ";pwd=123456"
Data2.RecordSource = "splsjlb"
Data2.Refresh
Data2.Recordset.MoveLast
Data2.Recordset.MoveFirst
Data3.DatabaseName = SystemPath + "dbase.mdb" '商品库存表
Data3.Connect = ";pwd=123456"
Data3.RecordSource = "spkcb"
Data3.Refresh
Data3.Recordset.MoveLast
Data3.Recordset.MoveFirst
Data4.DatabaseName = SystemPath + "dbase.mdb" '上机流水帐表
Data4.Connect = ";pwd=123456"
Data4.RecordSource = "sjlszb"
Data4.Refresh
Data4.Recordset.MoveLast
Data4.Recordset.MoveFirst
Data5.DatabaseName = SystemPath + "dbase.mdb" '客户商品表
Data5.Connect = ";pwd=123456"
Data5.RecordSource = "khspb"
Data5.Refresh
Data5.Recordset.MoveLast
Data5.Recordset.MoveFirst
Data6.DatabaseName = SystemPath + "dbase.mdb" '储金卡管理
Data6.Connect = ";pwd=123456"
Data6.RecordSource = "cjkgl"
Data6.Refresh
Data6.Recordset.MoveLast
Data6.Recordset.MoveFirst
Data7.DatabaseName = SystemPath + "dbase.mdb" '系统设置
Data7.Connect = ";pwd=123456"
Data7.RecordSource = "xtsz"
Data7.Refresh
Data7.Recordset.MoveLast
Data7.Recordset.MoveFirst
Data8.DatabaseName = SystemPath + "dbase.mdb" '用户设置表
Data8.Connect = ";pwd=123456"
Data8.RecordSource = "yhszb"
Data8.Refresh
Data8.Recordset.MoveLast
Data8.Recordset.MoveFirst
Data9.DatabaseName = SystemPath + "dbase.mdb" '客户设置表
Data9.Connect = ";pwd=123456"
Data9.RecordSource = "khglb"
Data9.Refresh
Data9.Recordset.MoveLast
Data9.Recordset.MoveFirst
Data10.DatabaseName = SystemPath + "dbase.mdb" '客户设置表
Data10.Connect = ";pwd=123456"
Data10.RecordSource = "quickhttp"
Data10.Refresh
Data10.Recordset.MoveLast
Data10.Recordset.MoveFirst
Data11.DatabaseName = SystemPath + "dbase.mdb" '客户设置表
Data11.Connect = ";pwd=123456"
Data11.RecordSource = "hickhttp"
Data11.Refresh
Data11.Recordset.MoveLast
Data11.Recordset.MoveFirst
'If ISRegRight = False Then
' Dim adata As String * 10, ndata As Date
' adata = String(10, 32)
' Open SystemPath + "wbjfq.exe" For Binary As #1
' Get #1, LOF(1) - 11, adata
'MsgBox adata, , LOF(1)
' Close #1
' ndata = adata
' Dim areg As String, breg As String
' areg = CStr((Year(ndata) + Month(ndata) + Day(ndata)) * 9)
' RegReadValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion", "CommonClass", 1, breg
' If areg <> breg Then
' If MsgBox("您的使用期已过，请您注册！", vbCritical + vbOKCancel) = vbOK Then
' frmRegSoft.Show vbModal, Me
' End If
' End
' End If
' If DateDiff("d", ndata, Date) > 50 Then
' If MsgBox("您的使用期已过，请您注册！", vbCritical + vbOKCancel) = vbOK Then
' frmRegSoft.Show vbModal, Me
' End If
' End
' End If
'End If
Longin
FlashShangPin
LoadShow False
'ListView1.ListItems.Add , , "全部计算机", 1
For i = 1 To Data1.Recordset.RecordCount
Select Case Data1.Recordset.Fields("状态").Value
Case "Y"
st = 3
Case "N"
st = 2
Case "P"
st = 4
Case "S"
st = 5
End Select
ListView1.ListItems.Add i, , Data1.Recordset.Fields("名称").Value, st, st
FlashListView (i)
Data1.Recordset.MoveNext
Next i
Form_Resize
ListView1_ItemClick ListView1.SelectedItem
Combo1.Text = Combo1.List(0)
Winsock2.Listen
End Sub
Private Sub Form_Resize()
'改变窗体大小
On Error Resume Next
ListView1.Width = Me.Width - 120
ListView1.Height = Me.Height - Toolbar1.Height - StatusBar1.Height - 800
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("如果当前还有机器正在记时，将无法正确提示时间！" + vbCrLf + "真的要退出吗？", vbQuestion + vbYesNo + vbDefaultButton2, "确实要退出吗？") = vbNo Then
Cancel = True
End If
End Sub
Private Sub ListView1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
ListView1_DblClick
End If
End Sub
Private Sub ListView1_DblClick()
'MsgBox ListView1.SelectedItem.Index
'xx = Screen.TwipsPerPixelX
'yy = Screen.TwipsPerPixelY
Beep
Select Case Data1.Recordset.Fields("状态")
Case "Y", "P"
'TabStrip1.Tabs(2).Selected = True
cdJF3_Click
Case "N", "S"
'TabStrip1.Tabs(1).Selected = True
cdJF1_Click
End Select
'Image2.Visible = True
'Form_Resize
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
On Error Resume Next
StatusBar1.Panels(1).Text = ListView1.ToolTipText
SelectComputer = Item.Index
With Data1.Recordset
.MoveFirst
'MsgBox Item.Index
.Move Item.Index - 1
SelectJSJ
End With
ListView1.SetFocus
End Sub
Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
If cdJF1.Enabled = True Then
PopupMenu cdJF, , , , cdJF1
Else
PopupMenu cdJF, , , , cdJF3
End If
End If
End Sub
Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'移动鼠标
'ListView1.HitTest(x, y).Text
On Error Resume Next
Select Case ListView1.HitTest(X, Y).Icon
Case 3
tt = "正在记费中"
Case 2
tt = "已经关机"
Case 5
tt = "正在待机中"
End Select
ListView1.ToolTipText = ListView1.HitTest(X, Y).Text & "状态：" & tt
If Err <> 0 Then ListView1.ToolTipText = ""
'StatusBar1.Panels(1).Text = ListView1.ToolTipText
End Sub
Private Sub Timer1_Timer()
StatusBar1.Panels(3).Text = Format(Now, "yyyy年mm月dd日hh:nn:ss ") & GetWeek(Date)
End Sub
Public Sub Timer2_Timer()
'每分钟刷新一次
On Error Resume Next
'a = CountJF
'ListView1_ItemClick ListView1.SelectedItem
With Data1.Recordset
Y = 0
n = 0
s = 0
p = 0
aa = .AbsolutePosition
.MoveFirst
For i = 1 To .RecordCount
FlashListView i
Select Case .Fields("状态")
Case "Y"
st = 3
Y = Y + 1
If .Fields("到点时间") < Now Then
For j = 0 To Winsock1.Count - 1
' MsgBox Winsock1(j).RemoteHostIP
If Winsock1(j).RemoteHostIP = .Fields("IP") Then
Winsock1(j).SendData "_comm" + Chr(0) + "stop" + Chr(0) + "OK$"
' "_comm" + Chr(0) + "stop"
DoEvents
Winsock1(j).SendData "_msgb" + Chr(0) + "你所定的时间已经到了，请到吧台去结帐！" + Chr(0) + "OK$"
DoEvents
Exit For
End If
Next j
If SupperMsgbox(.Fields("名称") & " 时间到了,是否要结帐?" & vbCrLf & _
"先择[确定]进入结帐界面,否则继续记费！", vbOKCancel) = vbOK Then
ListView1.ListItems(i).Selected = True
ListView1_ItemClick ListView1.ListItems(i)
TabStrip1.Tabs(2).Selected = True
Else
.Edit
.Fields("到点时间") = Null
.Update
For j = 0 To Winsock1.Count - 1
If Winsock1(j).RemoteHostIP = .Fields("IP") Then
Winsock1(j).SendData "_comm" + Chr(0) + "start" + Chr(0) + "OK$"
DoEvents
Exit For
End If
Next j
Timer2_Timer
End If
End If
Case "N"
n = n + 1
st = 2
Case "S"
st = 5
s = s + 1
findIt = False
For j = 0 To Winsock1.Count - 1
If Winsock1(j).RemoteHostIP = .Fields("IP") And .Fields("IP") <> "" Then
.Edit
.Fields("状态") = "S"
.Update
findIt = True
End If
Next j
If findIt = False Then
.Edit
.Fields("状态") = "N"
.Update
st = 2
End If
Case "P"
p = p + 1
st = 4
End Select
ListView1.ListItems(i).SmallIcon = st
ListView1.ListItems(i).Icon = st
.MoveNext
Next i
StatusBar1.Panels(2).Text = Y & "台记费中 " & p & "台暂停中"
.MoveFirst
.Move aa
End With
End Sub
Private Sub txtSJName_Change()
On Error Resume Next
comSjZhengJi.Text = ""
txtZhengJian.Text = ""
With Data9.Recordset
For i = 0 To txtSJName.ListCount - 1
If txtSJName.Text = txtSJName.List(i) Then
.MoveFirst
.Move txtSJName.ItemData(i)
comSjZhengJi.Text = .Fields("证件")
txtZhengJian.Text = .Fields("证件号码")
End If
Next i
End With
End Sub
Private Sub Winsock1_Close(Index As Integer)
'计算机关机
On Error Resume Next
With Data1.Recordset
aa = .AbsolutePosition
.MoveFirst
For i = 1 To .RecordCount
If .Fields("IP") = IndexSock(Index).Ip Then
If .Fields("状态") = "S" Then
.Edit
.Fields("状态") = "N"
.Update
ListView1.ListItems(i).Icon = 2
ListView1.ListItems(i).SmallIcon = 2
End If
End If
.MoveNext
Next i
.MoveFirst
.Move aa
Timer2_Timer
End With
End Sub
Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'当接到信息时
Dim strData As String
Dim comm As String
Dim findIt As Boolean
Dim ThisStr() As String, cc As Long
On Error Resume Next
Winsock1(Index).GetData strData, vbString
Select Case Left(strData, 5)
Case "_talk"
XianShiTalk strData, Index
Case "_comm"
comm = ""
cc = 0
For i = 1 To Len(strData)
a$ = Mid(strData, i, 1)
If a$ = Chr(0) Then
cc = cc + 1
Else
If cc = 1 Then comm = comm + a$
End If
Next i
Select Case comm
Case "start"
If frmScreen.Visible = True Then
Winsock1(Index).SendData "_msgb" + Chr(0) + "主机已被锁定，请稍后再试！" + Chr(0) + "OK$"
DoEvents
Exit Sub
End If
Unload frmScreen
With Data1.Recordset
aa = .AbsolutePosition
.MoveFirst
For i = 1 To .RecordCount
If .Fields("IP") = Winsock1(Index).RemoteHostIP Then
pd = vbNo
pd = SupperMsgbox(.Fields("名称") & "要求开机，是否同意？", vbYesNo)
If pd = vbYes Then
txtSJName = ""
txtZhengJian = ""
comSjZhengJi.Text = ""
Winsock1(Index).SendData "_comm" + Chr(0) + "start" + Chr(0) + "OK$"
DoEvents
.Edit
.Fields("状态").Value = "Y"
.Fields("开始时间").Value = Now
.Fields("客户姓名") = txtSJName
.Fields("客户证件") = comSjZhengJi
.Fields("证件号码") = txtZhengJian
.Fields("上机方式") = "N"
.Update
Timer2_Timer
End If
Exit Sub
End If
.MoveNext
Next i
.MoveFirst
.Move aa
End With
End Select
Case "_good" '商品
If frmScreen.Visible = True Then
Winsock1(Index).SendData "_msgb" + Chr(0) + "主机已被锁定，请稍后再试！" + Chr(0) + "OK$"
DoEvents
Exit Sub
End If
Unload frmScreen
cc = 0
ReDim Preserve ThisStr(cc) As String
For i = 1 To Len(strData)
ab$ = Mid(strData, i, 1)
If ab$ = Chr(0) Then
cc = cc + 1
ReDim Preserve ThisStr(cc) As String
Else
ThisStr(cc) = ThisStr(cc) + ab$
End If
Next i
sps = ""
'MsgBox thisStr(1)
For i = 1 To cc Step 3
sps = sps + ThisStr(i + 1) + Space(50 - LenB(StrConv(ThisStr(i + 1), vbFromUnicode))) & "数量：" & ThisStr(i + 2) & vbCrLf
Next i
With Data1.Recordset
aa = .AbsolutePosition
.MoveFirst
For i = 1 To .RecordCount
If .Fields("IP") = Winsock1(Index).RemoteHostIP Then
If SupperMsgbox(.Fields("名称") & "要求选择下列商品，是否同意？" + vbCrLf + sps, vbYesNo, "有人要商品", 90) = vbYes Then
Winsock1(Index).SendData "_msgb" + Chr(0) + "请您稍候，马上把你要的商品送到！" + Chr(0) + "OK$"
For j = 1 To cc Step 3
Data3.Recordset.MoveFirst
For k = 1 To Data3.Recordset.RecordCount
If ThisStr(j) = Data3.Recordset.Fields("商品编号") Then
Data3.Recordset.Edit
Data3.Recordset.Fields("库存数量") = Data3.Recordset.Fields("库存数量") - Val(ThisStr(j + 2))
Data3.Recordset.Update
Exit For
End If
Data3.Recordset.MoveNext
Next k
Data2.Recordset.MoveFirst
For k = 1 To Data2.Recordset.RecordCount
If Data2.Recordset.Fields("商品编号") = ThisStr(j) And Data2.Recordset.Fields("机号") = .Fields("机号") Then
findIt = True
Exit For
End If
Data2.Recordset.MoveNext
Next k
If findIt = True Then
Data2.Recordset.Edit
Else
Data2.Recordset.AddNew
End If
Data2.Recordset.Fields("机号") = .Fields("机号")
Data2.Recordset.Fields("商品编号") = ThisStr(j)
Data2.Recordset.Fields("数量") = Data2.Recordset.Fields("数量") + Val(ThisStr(j + 2))
Data2.Recordset.Fields("时间") = Now
Data2.Recordset.Update
Next j
DoEvents
End If
Exit Sub
End If
.MoveNext
Next i
Timer2_Timer
.MoveFirst
.Move aa
End With
Case "_gets" '获取
ReDim ThisStr(4) As String
cc = 0
For i = 1 To Len(strData)
a$ = Mid(strData, i, 1)
If a$ = Chr(0) Then
cc = cc + 1
Else
ThisStr(cc) = ThisStr(cc) + a$
End If
Next i
Select Case ThisStr(1)
Case "good"
With Data3.Recordset
.MoveFirst
strData = "_gets" + Chr(0) + "good" + Chr(0)
For i = 1 To .RecordCount
strData = strData + .Fields("商品编号") + Chr(0) + .Fields("商品名称") + Chr(0) + CStr(.Fields("零售价格")) + Chr(0)
.MoveNext
Next i
Winsock1(Index).SendData strData + Chr(0) + "OK$"
DoEvents
End With
Case "time"
For i = 0 To Winsock1.Count - 1
If Index = IndexSock(i).Index Then
'ListView1.ListItems(IndexSock(i).JSJ).Text
Winsock1(Index).SendData "_msgb" + Chr(0) + "您的上机情况是：" + vbCrLf + _
"开始时间：" + ListView1.ListItems(IndexSock(i).JSJ).SubItems(1) + vbCrLf + _
"到点时间：" + ListView1.ListItems(IndexSock(i).JSJ).SubItems(2) + vbCrLf + _
"已用时间：" + ListView1.ListItems(IndexSock(i).JSJ).SubItems(3) + vbCrLf + _
"暂停时间：" + ListView1.ListItems(IndexSock(i).JSJ).SubItems(4) + vbCrLf + _
"金 额：" + ListView1.ListItems(IndexSock(i).JSJ).SubItems(5) + vbCrLf + _
"其他费用：" + ListView1.ListItems(IndexSock(i).JSJ).SubItems(6) + vbCrLf + _
"总 金 额：" + ListView1.ListItems(IndexSock(i).JSJ).SubItems(7) + Chr(0) + "OK$"
DoEvents
DoEvents
Exit Sub
End If
Next i
Case "card"
Data6.Recordset.MoveFirst
For i = 1 To Data6.Recordset.RecordCount
'MsgBox Data6.Recordset.Fields("卡号"), , thisStr(2)
If Data6.Recordset.Fields("卡号") = ThisStr(2) Then
If Data6.Recordset.Fields("密码") = ThisStr(3) Then
Winsock1(Index).SendData "_msgb" + Chr(0) + "你要查的卡号是：" + Data6.Recordset.Fields("卡号") + vbCrLf + _
"总金额为：" + Format(Data6.Recordset.Fields("总金额"), "###0.0元") + " 总机时为：" + Format(Data6.Recordset.Fields("总机时"), "###0.00小时") + vbCrLf + _
"已用机时：" + Format(Data6.Recordset.Fields("已用机时"), "###0.00小时") + vbCrLf + _
"剩余金额：" + Format(Data6.Recordset.Fields("金额"), "###0.0元") + Chr(0) + "OK$"
Else
Winsock1(Index).SendData "_msgb" + Chr(0) + "您所输入的密码错误！" + Chr(0) + "OK$"
End If
DoEvents
Exit Sub
End If
Data6.Recordset.MoveNext
Next i
Winsock1(Index).SendData "_msgb" + Chr(0) + "您所输入的卡号错误！" + Chr(0) + "OK$"
DoEvents
End Select
DoEvents
Case "_ereg"
Case "_sets"
Case "_vali"
ReDim ThisStr(3) As String
cc = 0
For i = 1 To Len(strData)
a$ = Mid(strData, i, 1)
If a$ = Chr(0) Then
cc = cc + 1
Else
ThisStr(cc) = ThisStr(cc) + a$
End If
Next i
'MsgBox thisStr(3)
Select Case ThisStr(3)
Case "setup", "close", "shutdown" '如果是设置
With Data8.Recordset
.MoveFirst
For i = 1 To .RecordCount
If .Fields("用户名称") = ThisStr(1) And .Fields("用户密码") = ThisStr(2) Then
If (ThisStr(3) = "close" Or ThisStr(3) = "setup") And .Fields("权限") < "C" Then
Winsock1(Index).SendData "_msgb" + Chr(0) + "验证用户名权限不够！" + Chr(0) + "OK$"
DoEvents
Exit Sub
End If
Winsock1(Index).SendData "_comm" + Chr(0) + ThisStr(3) + Chr(0) + "OK$"
DoEvents
Exit Sub
End If
.MoveNext
Next i
Winsock1(Index).SendData "_msgb" + Chr(0) + "验证用户名或密码错误，不能完成指令！" + Chr(0) + "OK$"
DoEvents
End With
Case "cardend"
If frmScreen.Visible = True Then
Winsock1(Index).SendData "_msgb" + Chr(0) + "主机已被锁定，请稍后再试！" + Chr(0) + "OK$"
DoEvents
Exit Sub
End If
Unload frmScreen
Timer2_Timer
Data6.Recordset.MoveFirst
For i = 1 To Data6.Recordset.RecordCount
' MsgBox Data6.Recordset.Fields("卡号"), , thisStr(2)
If Data6.Recordset.Fields("卡号") = ThisStr(1) Then
If Data6.Recordset.Fields("密码") = ThisStr(2) Then '如果通过验证
' If Data6.Recordset.Fields("金额") < Val(ListView1.ListItems(IndexSock(i).JSJ).SubItems(7)) Then
' Winsock1(Index).SendData "_msgb" + Chr(0) + "您所输入的储金卡金额不够，不能结帐！"
' DoEvents
' Exit Sub
' End If
With Data1.Recordset
aa = .AbsolutePosition
.MoveFirst
For j = 1 To .RecordCount
If .Fields("IP") = Winsock1(Index).RemoteHostIP Then
If MsgBox(.Fields("名称") & "要求用卡号为：" & ThisStr(1) & "的储金卡结帐，是否同意！", vbYesNo + vbQuestion) = vbYes Then
ListView1.ListItems(j).Selected = True
ListView1_ItemClick ListView1.SelectedItem
Check1.Value = 1
txtKaHaoMa.Text = ThisStr(1)
txtKaMiMa.Text = ThisStr(2)
'问题 Command1_Click
Else
Winsock1(Index).SendData "_msgb" + Chr(0) + "主机拒绝用此卡结帐！" + Chr(0) + "OK$"
DoEvents
End If
Exit Sub
End If
.MoveNext
Next j
End With
Else
Winsock1(Index).SendData "_msgb" + Chr(0) + "您所输入的密码错误，不能结帐！" + Chr(0) + "OK$"
End If
DoEvents
Exit Sub
End If
Data6.Recordset.MoveNext
Next i
Winsock1(Index).SendData "_msgb" + Chr(0) + "您所输入的卡号错误，不能结帐！" + Chr(0) + "OK$"
DoEvents
End Select
Case "_sele"
comm = ""
cc = 0
For i = 1 To Len(strData)
a$ = Mid(strData, i, 1)
If a$ = Chr(0) Then
cc = cc + 1
Else
If cc = 1 Then comm = comm + a$
End If
Next i
IndexSock(Index).JSJ = Val(comm)
With Data1.Recordset
aa = .AbsolutePosition
.MoveFirst
For i = 1 To .RecordCount
If .Fields("机号") = IndexSock(Index).JSJ Then
Select Case .Fields("状态")
Case "Y"
Winsock1(Index).SendData "_comm" + Chr(0) + "start" + Chr(0) + "OK$"
DoEvents
Case "P"
Winsock1(Index).SendData "_comm" + Chr(0) + "pause" + Chr(0) + "OK$"
DoEvents
End Select
.Edit
.Fields("IP") = IndexSock(Index).Ip
If .Fields("状态") = "N" Then
.Fields("状态") = "S"
ListView1.ListItems(i).Icon = 5
ListView1.ListItems(i).SmallIcon = 5
End If
.Update
Timer2_Timer
Exit For
End If
.MoveNext
Next i
a1 = Timer
Do While a1 + 1 > Timer
DoEvents
Loop
DoEvents
SetHickHttp Index
DoEvents
SetQuickHttp Index
.MoveFirst
.Move aa
End With
Case "_prog"
frmComputer.Show
frmComputer.FlashList1 strData
End Select
End Sub
Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)
'远程请求连接
On Error Resume Next
For i = 0 To Winsock1.Count - 1
'MsgBox Winsock1(i).State
If Winsock1(i).State <> sckConnected Then
Winsock1(i).Close
Winsock1(i).Accept requestID
ReDim Preserve IndexSock(Winsock1.Count) As Lwinsock
ReDim Preserve IChatUser(Winsock1.Count) As lChatUser
For j = 0 To Winsock1.Count - 1
IndexSock(j).Ip = Winsock1(j).RemoteHostIP
IndexSock(j).Index = i
' MsgBox IndexSock(j).Ip
Next j
Exit Sub
End If
Next i
Load Winsock1(Winsock1.Count)
Winsock1(Winsock1.Count - 1).Accept requestID
ReDim Preserve IndexSock(Winsock1.Count) As Lwinsock
ReDim Preserve IChatUser(Winsock1.Count) As lChatUser
For i = 0 To Winsock1.Count - 1
IndexSock(i).Ip = Winsock1(i).RemoteHostIP
IndexSock(i).Index = i
' MsgBox IndexSock(i).Ip
Next i
End Sub
Public Sub SelectJSJ()
'选中计算机
On Error Resume Next
'List1.Clear
'List2.Clear
With Data1.Recordset
'Select Case Data1.Recordset.Fields("状态").Value
' Case "Y"
' st = 3
' Case "N"
' st = 2
' Case "P"
' st = 4
' Case "S"
' st = 5
'End Select
Select Case .Fields("状态").Value
Case "Y"
cdJF1.Enabled = False
cdJF2.Enabled = True
cdJF3.Enabled = True
cdJF4.Enabled = True
cdJF5.Enabled = True
cdJF6.Enabled = True
cdJF7.Enabled = True
Toolbar1.Buttons(1).Enabled = False
Toolbar1.Buttons(2).Enabled = True
Case "N"
cdJF1.Enabled = True
cdJF2.Enabled = False
cdJF3.Enabled = False
cdJF4.Enabled = False
cdJF5.Enabled = False
cdJF6.Enabled = False
cdJF7.Enabled = False
Toolbar1.Buttons(1).Enabled = True
Toolbar1.Buttons(2).Enabled = False
Case "S"
cdJF1.Enabled = True
cdJF2.Enabled = False
cdJF3.Enabled = False
cdJF4.Enabled = False
cdJF5.Enabled = False
cdJF6.Enabled = True
cdJF7.Enabled = True
Toolbar1.Buttons(1).Enabled = True
Toolbar1.Buttons(2).Enabled = False
End Select
End With
End Sub
Function CountJF() As Double
'统计费用
On Error Resume Next
Dim Zje As Double
With Data1.Recordset
预交金额 = .Fields("已收款")
设定时 = ""
设定分 = ""
txtSJName = .Fields("客户姓名")
txtZhengJian = .Fields("证件号码")
comSjZhengJi.Text = .Fields("客户证件")
' RtBox1.SelText = vbCrLf + "开始时间：" + Format(.Fields("开始时间").Value, "m月d日 hh:nn:ss")
If .Fields("上机方式") = "P" Then
' RtBox1.SelText = vbCrLf + "通宵记费方式"
Zje = Data7.Recordset.Fields("通宵金额")
Else
' RtBox1.SelText = vbCrLf + "到点时间：" + Format(.Fields("到点时间").Value, "m月d日 hh:nn:ss")
' RtBox1.SelText = vbCrLf + "已经暂停时间：" & .Fields("暂停时间") \ 60 & "小时" & .Fields("暂停时间") Mod 60 & "分钟"
' RtBox1.SelText = vbCrLf + "开始暂停时间：" + Format(.Fields("暂停开始").Value, "m月d日 hh:nn:ss")
' RtBox1.SelText = vbCrLf + "当前暂停时间：" & DateDiff("n", .Fields("暂停开始"), Now) \ 60 & "小时" & DateDiff("n", .Fields("暂停开始"), Now) Mod 60 & "分钟"
mm = DateDiff("n", .Fields("开始时间"), Now)
If .Fields("暂停时间") <> "" And .Fields("暂停时间") > 0 Then mm = mm - .Fields("暂停时间") - DateDiff("n", .Fields("暂停开始"), Now)
' RtBox1.SelText = vbCrLf + "运行时间：" & mm \ 60 & "小时" & mm Mod 60 & "分钟"
Zje = .Fields("单位费用").Value * mm / 60
End If
If Zje <= Data7.Recordset.Fields("最低消费额") Then Zje = Data7.Recordset.Fields("最低消费额")
If Data7.Recordset.Fields("取整金额") = 0.5 Then
Zje = Round(Zje * 2) / 2
Else
Zje = Round(Zje)
End If
'RtBox1.SelText = vbCrLf + "应付金额：" & Format(Zje, "###,###0.00元")
'RtBox1.SelText = vbCrLf + "已付金额：" & Format(.Fields("已收款"), "###,###0.00元")
' RtBox1.SelColor = &H0
'RtBox1.SelText = vbCrLf + "其他花费："
Data2.Recordset.MoveFirst
For i = 1 To Data2.Recordset.RecordCount
If Data2.Recordset.Fields("机号").Value = .Fields("机号").Value Then
Data3.Recordset.MoveFirst
For j = 1 To Data3.Recordset.RecordCount
If Data3.Recordset.Fields("商品编号").Value = Data2.Recordset.Fields("商品编号").Value Then Exit For
Data3.Recordset.MoveNext
Next j
'RtBox1.SelText = vbCrLf + Data3.Recordset.Fields("商品名称") & " 数量：" & Data2.Recordset.Fields("数量").Value & " 金额：" & Data2.Recordset.Fields("数量").Value * Data3.Recordset.Fields("零售价格") & "元"
Zje = Zje + Data2.Recordset.Fields("数量").Value * Data3.Recordset.Fields("零售价格")
End If
Data2.Recordset.MoveNext
Next i
'RtBox1.SelColor = &HFF
' If Zje <= 0.5 Then Zje = 0.5
' RtBox1.SelText = vbCrLf + "总计金额：" & Format(Round((Zje - .Fields("已收款")) * 2) / 2, "###,###0.00元")
If Data7.Recordset.Fields("取整金额") = 0.5 Then
Zje = Round(Zje * 2) / 2
Else
Zje = Round(Zje)
End If
' txtYingShou.Text = Format(Zje, "#0.00")
' txtYiShou.Text = Format(.Fields("已收款"), "#0.00")
' txtShiShou.Text = Format(Zje, "#0.00") 'Format(Round((Zje - .Fields("已收款")) * 2) / 2, "#0.00")
'nnn = .AbsolutePosition
End With
CountJF = Zje
End Function
Sub ClearJF()
'结帐
On Error Resume Next
Dim Yinshou As Double, shishou As Double, ID As Double
aa = frmEndPlay.txtShiShou
bb = frmEndPlay.txtYingShou
Yinshou = CountJF
shishou = Round(Val(frmEndPlay.txtShiShou.Text) * Yinshou / Val(frmEndPlay.txtYingShou), 2)
With Data1.Recordset
ID = Data4.Recordset.RecordCount + 1
Data4.Recordset.AddNew
Data4.Recordset.Fields("ID") = ID
Data4.Recordset.Fields("机号") = .Fields("机号")
Data4.Recordset.Fields("开始时间") = .Fields("开始时间")
Data4.Recordset.Fields("结束时间") = Now
Data4.Recordset.Fields("应收款") = Yinshou
Data4.Recordset.Fields("实收款") = shishou
Data4.Recordset.Fields("上机方式") = .Fields("上机方式")
Data4.Recordset.Fields("优惠") = Val(comYouHui.Text)
Data4.Recordset.Fields("结帐人") = UserName
Data4.Recordset.Fields("客户姓名") = .Fields("客户姓名")
Data4.Recordset.Fields("客户证件") = .Fields("客户证件")
Data4.Recordset.Fields("证件号码") = .Fields("证件号码")
Data4.Recordset.Update
Data9.Recordset.MoveFirst
For i = 1 To Data9.Recordset.RecordCount
If Data9.Recordset.Fields("客户姓名") = .Fields("客户姓名") Then
Data9.Recordset.Edit
Data9.Recordset.Fields("消费额") = Data9.Recordset.Fields("消费额") + shishou
Data9.Recordset.Fields("消费次数") = Data9.Recordset.Fields("消费次数") + 1
Data9.Recordset.Fields("最后一次时间") = Now
Data9.Recordset.Update
End If
Data9.Recordset.MoveNext
Next i
.Edit
.Fields("开始时间").Value = Null
.Fields("到点时间").Value = Null
.Fields("暂停开始").Value = Null
.Fields("暂停时间").Value = 0
.Fields("已收款").Value = 0
.Fields("状态").Value = "S"
.Fields("上机方式").Value = ""
.Fields("客户姓名") = ""
.Fields("客户证件") = ""
.Fields("证件号码") = ""
.Update
For i = 0 To Winsock1.Count - 1
If Data1.Recordset.Fields("IP") = Winsock1(i).RemoteHostIP Then
Winsock1(i).SendData "_comm" + Chr(0) + "stop" + Chr(0) + "OK$"
DoEvents
Exit For
End If
Next i
End With
ListView1.ListItems(SelectComputer).Icon = 5
ListView1.ListItems(SelectComputer).SmallIcon = 5
ListView1.ListItems(SelectComputer).Selected = True
For i = 1 To 9
ListView1.ListItems(SelectComputer).SubItems(i) = ""
Next i
With Data2.Recordset
.MoveFirst
For i = 1 To .RecordCount
If .Fields("机号") = Data1.Recordset.Fields("机号") Then
Data5.Recordset.AddNew
Data5.Recordset.Fields("ID") = ID
Data5.Recordset.Fields("机号") = .Fields("机号")
Data5.Recordset.Fields("商品编号") = .Fields("商品编号")
Data5.Recordset.Fields("数量") = .Fields("数量")
Data5.Recordset.Fields("时间") = .Fields("时间")
Data5.Recordset.Update
.Delete
End If
.MoveNext
Next i
End With
End Sub
Sub Longin()
If Data8.Recordset.RecordCount > 0 Then
frmLogin.Show vbModal, Me
Else
UserPass = "D"
Exit Sub
End If
'设置权限
cdTJ.Enabled = False
'cdGL.Enabled = False
cdGL2.Enabled = False
cdGL3.Enabled = False
cdGL4.Enabled = False
cd11.Enabled = False
cd12.Enabled = False
cd13.Enabled = False
cd14.Enabled = False
cd16.Enabled = False
If UserPass > "A" Then
cdGL2.Enabled = True
End If
If UserPass > "B" Then
cdTJ.Enabled = True
cdGL3.Enabled = True
cdGL4.Enabled = True
End If
If UserPass > "C" Then
cdTJ.Enabled = True
cdGL.Enabled = True
cd11.Enabled = True
cd12.Enabled = True
cd13.Enabled = True
cd14.Enabled = True
cd16.Enabled = True
End If
Me.Caption = "网吧记费器——用户：" + UserName
LoadShow False
End Sub
Sub FlashShangPin()
On Error Resume Next
Data3.Recordset.MoveFirst
List3.Clear
For i = 1 To Data3.Recordset.RecordCount
List3.AddItem Data3.Recordset.Fields("商品名称")
List3.ItemData(List3.NewIndex) = Data3.Recordset.AbsolutePosition
Data3.Recordset.MoveNext
Next i
End Sub
Sub FlashListView(Index)
On Error Resume Next
Dim Zje As Double, Shangpin As Double
With Data1.Recordset
If .Fields("状态") <> "S" And .Fields("状态") <> "N" Then
'开机时间
ListView1.ListItems(Index).SubItems(1) = Format(.Fields("开始时间"), "m月d日 hh:nn")
'到点时间
ListView1.ListItems(Index).SubItems(2) = Format(.Fields("到点时间"), "m月d日 hh:nn")
'已用时间
If .Fields("上机方式") = "P" Then
RTBox1.SelText = vbCrLf + "通宵记费方式"
Zje = Data7.Recordset.Fields("通宵金额")
ListView1.ListItems(Index).SubItems(3) = "通宵方式"
Else
mm = DateDiff("n", .Fields("开始时间"), Now)
' nn = DateDiff("n", .Fields("暂停开始"), Now)
If .Fields("开始时间") <> "" Then ListView1.ListItems(Index).SubItems(3) = "" & mm \ 60 & ":" & mm Mod 60 ' & "分钟"
' If nn > 0 Then ListView1.ListItems(Index).SubItems(4) = "" & .Fields("暂停时间") \ 60 & "小时" & .Fields("暂停时间") Mod 60 & "分钟"
Zje = .Fields("单位费用").Value * mm / 60
'金额
End If
If Zje <= Data7.Recordset.Fields("最低消费额") Then Zje = Data7.Recordset.Fields("最低消费额")
If Data7.Recordset.Fields("取整金额") = 0.5 Then
Zje = Round(Zje * 2) / 2
Else
Zje = Round(Zje)
End If
ListView1.ListItems(Index).SubItems(5) = Format(Zje, "###,###0.00元")
'其他花费
Data2.Recordset.MoveFirst
For i = 1 To Data2.Recordset.RecordCount
If Data2.Recordset.Fields("机号").Value = .Fields("机号").Value Then
Data3.Recordset.MoveFirst
For j = 1 To Data3.Recordset.RecordCount
If Data3.Recordset.Fields("商品编号").Value = Data2.Recordset.Fields("商品编号").Value Then Exit For
Data3.Recordset.MoveNext
Next j
Shangpin = Shangpin + Data2.Recordset.Fields("数量").Value * Data3.Recordset.Fields("零售价格")
End If
Data2.Recordset.MoveNext
Next i
If Shangpin > 0 Then ListView1.ListItems(Index).SubItems(6) = Format(Shangpin, "###,###0.00元")
Zje = Round(Zje * 2) / 2
Zje = Zje + Shangpin
ListView1.ListItems(Index).SubItems(7) = Format(Zje, "###,###0.00元")
ListView1.ListItems(Index).SubItems(4) = Format(.Fields("单位费用"), "###,###0.00元")
ListView1.ListItems(Index).SubItems(8) = .Fields("客户姓名")
End If
End With
End Sub
Sub LoadShow(def As Boolean)
'显示界面
On Error Resume Next
Dim find As Boolean
With Data8.Recordset
.MoveFirst
For i = 1 To .RecordCount
If .Fields("用户名称") = UserName Then
find = True
Exit For
End If
.MoveNext
Next i
If find = False Then Exit Sub
ListView1.Font.Name = "宋体" '.Fields("字体")
ListView1.Font.Size = 9 ' .Fields("字号")
ListView1.ForeColor = 0 '.Fields("字体颜色")
ListView1.Font.Bold = False ' .Fields("粗体")
ListView1.Font.Italic = False '.Fields("斜体")
ListView1.Picture = Nothing ' LoadPicture(.Fields("背景"))
ListView1.BackColor = &H80000005 ' .Fields("背景颜色")
If def Then
.Edit
.Fields("字体") = ListView1.Font.Name
.Fields("字号") = ListView1.Font.Size
.Fields("字体颜色") = 0
.Fields("粗体") = ListView1.Font.Bold
.Fields("斜体") = ListView1.Font.Italic
.Fields("背景") = ""
.Fields("背景颜色") = &H80000005 'ListView1.BackColor
.Update
Else
ListView1.Font.Name = .Fields("字体")
ListView1.Font.Size = .Fields("字号")
ListView1.ForeColor = .Fields("字体颜色")
ListView1.Font.Bold = .Fields("粗体")
ListView1.Font.Italic = .Fields("斜体")
ListView1.Picture = LoadPicture(.Fields("背景"))
ListView1.BackColor = .Fields("背景颜色")
If ListView1.ForeColor = ListView1.BackColor Then
ListView1.BackColor = &H80000005 ' .Fields("背景颜色")
ListView1.ForeColor = 0 '.Fields("字体颜色")
End If
End If
End With
End Sub
Sub XianShiTalk(iStr As String, Index As Integer)
'显示聊天
On Error Resume Next
Dim ThisStr(11) As String, cc As Long
cc = 0
For i = 1 To Len(iStr)
a$ = Mid(iStr, i, 1)
If a$ = Chr(0) Then
cc = cc + 1
Else
ThisStr(cc) = ThisStr(cc) + a$
End If
Next i
Select Case ThisStr(1)
Case "talk", "change", "quit"
For i = 0 To Winsock1.Count - 1
If ThisStr(1) = "quit" And ThisStr(2) = IChatUser(i).Name Then
IChatUser(i).Name = ""
IChatUser(i).Sex = ""
IChatUser(i).Used = False
End If
DoEvents
Winsock1(i).SendData iStr + Chr(0) + "OK$"
Next i
DoEvents
Case "login"
For i = 0 To Winsock1.Count - 1
If IChatUser(i).Name = ThisStr(2) Then
DoEvents
Winsock1(Index).SendData "_talk" + Chr(0) + "login" + Chr(0) + Chr(0) + Chr(0) + "OK$"
DoEvents
Exit Sub
End If
Next i
For i = 0 To Winsock1.Count - 1
If IChatUser(i).Used = False Then
IChatUser(i).Used = True
IChatUser(i).Name = ThisStr(2)
IChatUser(i).Sex = ThisStr(3)
' Winsock1(Index).SendData iStr
Exit For
End If
Next i
For i = 0 To Winsock1.Count - 1
DoEvents
If IChatUser(i).Used = True And IChatUser(i).Name <> "" And IChatUser(i).Name <> ThisStr(2) Then
Winsock1(Index).SendData "_talk" + Chr(0) + "login" + Chr(0) + IChatUser(i).Name + Chr(0) + IChatUser(i).Sex + Chr(0) + "OK$"
End If
DoEvents
Winsock1(i).SendData iStr + Chr(0) + "OK$"
Next i
DoEvents
End Select
End Sub
Public Sub SetQuickHttp(Index As Integer)
'设置快速网址
On Error Resume Next
Dim qstring As String
With Data10.Recordset
.MoveFirst
For i = 1 To .RecordCount
qstring = qstring + .Fields("网站名称") + Chr(0) + .Fields("网站地址") + Chr(0)
.MoveNext
Next i
Winsock1(Index).SendData "_http" + Chr(0) + qstring + Chr(0) + "OK$"
DoEvents
End With
End Sub
Public Sub SetHickHttp(Index As Integer)
'设置快速网址
On Error Resume Next
Dim qstring As String
With Data11.Recordset
.MoveFirst
For i = 1 To .RecordCount
qstring = qstring + .Fields("网站") + Chr(0)
.MoveNext
Next i
Winsock1(Index).SendData "_hick" + Chr(0) + qstring + Chr(0) + "OK$"
DoEvents
End With
End Sub