frmmain.frm

提供一个网吧管理系统的VB源代码供大家学习

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