frmmain.frm

一个VB写的UDP协议的C/S模式的服务程序

            strWine = strWine & rs!type_name & ";"
            rs.MoveNext
        Wend
        If rs.State = adStateOpen Then rs.Close
        
        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
        
            If pos > 4096 Then Exit For
        Next
        bt(pos) = 0
        ws.SendData bt

    Case 4  '物品信息请求
     
        bt(0) = 13
        bt(1) = 4
        pos = 2
        
        i = InStr(3, str, ",")
        typeName = Trim$(Right$(str, Len(str) - i))
        
        For i = 1 To Len(typeName)
            If Asc(Mid$(typeName, i, 1)) = 0 Then
                typeName = Left$(typeName, i - 1)
                Exit For
            End If
        Next
        
        If rs.State = adStateOpen Then rs.Close
        rs.Open "select * from product_type where type_name='" & Trim$(typeName) & "'", cnn, adOpenDynamic, adLockOptimistic
        typeid = Val("0" & rs!type_id)
        If rs.State = adStateOpen Then rs.Close
        
        rs.Open "SELECT * FROM product  where type_id='" & Trim$(typeid) & "' and user_flag=true", cnn, adOpenDynamic, adLockOptimistic
        strWine = ""

        While Not rs.EOF
            strWine = strWine & rs!product_name & "   " & rs!product_yzh & " 元" & ";"
            rs.MoveNext
        Wend
        If rs.State = adStateOpen Then rs.Close

        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
            
            If pos > 4096 Then Exit For
            
        Next
        bt(pos) = 0
        ws.SendData bt

    Case 6 '消费查询
    
        bt(0) = 13
        bt(1) = 6
        pos = 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
        
        If rs.State = adStateOpen Then rs.Close
        rs.Open "select * from roominfo where room_number='" & RoomName & "'", cnn, adOpenDynamic, adLockOptimistic
        If Not rs.EOF Then
            MinCos = Val("0" & rs!min_price)
            wineCos = Val("0" & rs!supplier_id)
            lServiceFee = Val("0" & rs!planpeoplecount)
        Else
            MinCos = 0
            wineCos = 0
            lServiceFee = 0
        End If
        If rs.State = adStateOpen Then rs.Close
        
        rs.Open "select  sum(finalprice) from sale_temp where room_number='" & RoomName & "'", cnn, adOpenDynamic, adLockOptimistic
        total = CDbl("0" & rs.Fields(0))
        If rs.State = adStateOpen Then rs.Close
        
        Dim tt As Long
        tt = total + lServiceFee
        If tt >= wineCos Then
            strWine = "[包厢名:" & RoomName & Chr(10) & "包厢费:" & MinCos & Chr(10) & "最低消费:" & wineCos & Chr(10) & _
                      "服务费:" & lServiceFee & Chr(10) & "酒水金额:" & total & Chr(10) & "总金额:" & tt + MinCos & Chr(10) & "]"
        Else
            strWine = "[包厢名:" & RoomName & Chr(10) & "包厢费:" & MinCos & Chr(10) & "最低消费:" & wineCos & Chr(10) & _
                      "服务费:" & lServiceFee & Chr(10) & "酒水金额:" & total & Chr(10) & "总金额:" & tt + MinCos & Chr(10) & "差额:" & wineCos - tt & Chr(10) & "]"
        End If
        If rs.State = adStateOpen Then rs.Close
        rs.Open "SELECT * FROM sale_temp where room_number='" & Trim$(RoomName) & "'", cnn, adOpenDynamic, adLockOptimistic
        
        While Not rs.EOF
            strWine = strWine & rs!product_name & "  " & rs!qty & "  " & rs!price & "  " & Val("0" & rs!price) * Val("0" & rs!qty) & Chr(10)
            rs.MoveNext
        Wend
        If rs.State = adStateOpen Then rs.Close
        
        For i = 1 To Len(strWine)
        
            a = Hex(Asc(Mid$(strWine, i, 1)))
            If Len(a) > 2 Then
                If pos > 4095 Then Exit For
                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
            If pos > 4096 Then Exit For
        Next
        bt(pos) = 0
        ws.SendData bt
        
    Case 11  '酒水提交

        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
        
        For i = prePos To Len(str)
            If Mid$(str, i, 1) = "," Then
                pwd = Mid$(str, prePos, i - prePos)
                prePos = i + 1
                Exit For
            End If
        Next
        
        '###################         检查密码       ##################
        If rs.State = adStateOpen Then rs.Close
        rs.Open "select * from users where user_id = '" & userName & "'", cnn, adOpenDynamic, adLockOptimistic
        If rs.EOF Then
            bt(0) = 13
            bt(1) = 11
            bt(2) = 0
            ws.SendData bt
            Exit Sub
        Else
            If pwd <> "" & rs!user_pass Then
                bt(0) = 13
                bt(1) = 11
                bt(2) = 0
                ws.SendData bt
                Exit Sub
            End If
        
        End If
        If rs.State = adStateOpen Then rs.Close
        
        '########################################################
        
        '取得酒水明细
        For i = prePos To Len(str)
            If Asc(Mid$(str, i, 1)) = 0 Then
                str = Mid$(str, prePos, i - 1)
                Exit For
            End If
        Next
        
        sTokens = Split(str, ";")
        
    errPos = 0
        On Error GoTo commiterr
    cnn.BeginTrans
        
        For Each ss In sTokens
            If Len(ss) > 0 Then
                If Asc(Right(ss, 1)) > 0 Then
                    st = Split(ss, ",")
                    pName = st(0)           '酒水明细中的酒水 "物品名称  xx元"
                    num = Val("0" & st(1))  '酒水明细中的酒水 数量
                    For i = 1 To Len(pName) '取得  "物品名称" 和 "单价"
                        If Mid$(pName, i, 1) = " " Then
                            price = Val(Right$(pName, Len(pName) - i))
                            pName = Left$(pName, i - 1)
                            Exit For
                        End If
                    Next
                    
                    If rs.State = adStateOpen Then rs.Close
                    rs.Open "select * from product where product_name='" & Trim$(pName) & "'", cnn, adOpenDynamic, adLockOptimistic
                    If Not rs.EOF Then
                        pid = "" & rs!p_id
                        strUnit = "" & rs!unit
                        cnn.Execute "insert into sale_temp (room_number,p_id,product_name,price,qty,daze,finalprice,starttime,unit) values ('" & RoomName & "','" & pid & "','" & pName & "'," & price & "," & num & ",100," & price * num & ",now,'" & strUnit & "')"

                    End If
                    If rs.State = adStateOpen Then rs.Close

                End If
            End If
        Next
    cnn.CommitTrans
    
    On Error GoTo errdeal
        
        bt(0) = 13
        bt(1) = 11
        bt(2) = 1
        bt(3) = 0
        ws.SendData bt
        
      Case 20 '私歌新用户注册
        If rs.State = adStateOpen Then rs.Close
        
        sTokens = Split(str, ",")
        userNumber = Right(sTokens(0), Len(sTokens(0)) - 2)
        pwd = sTokens(1)
        
       
        dp = InStr(1, pwd, Chr(0), vbBinaryCompare)
        pwd = Left(pwd, dp - 1)
        
        rs.Open "select * from puser where mnumber='" & userNumber & "'", cnn, adOpenDynamic, adLockOptimistic
        If rs.EOF Then
            cnn.Execute "insert into puser (MNumber , pwd) values ('" & userNumber & "','" & pwd & "')"
            bt(0) = 13
            bt(1) = 20
            bt(2) = 1
            bt(3) = 0
            
        Else
            bt(0) = 13
            bt(1) = 20
            bt(2) = 0
            bt(3) = 0
            
        End If
        ws.SendData bt
        
    Case 21
        Dim newPwd As String
        sTokens = Split(str, ",")
        userNumber = Right(sTokens(0), Len(sTokens(0)) - 2)
        pwd = sTokens(1)
        newPwd = sTokens(2)
        dp = InStr(1, newPwd, Chr(0), vbBinaryCompare)
        newPwd = Left(newPwd, dp - 1)
        
        If rs.State = adStateOpen Then rs.Close
        rs.Open "select * from puser where mnumber='" & userNumber & "'", cnn, adOpenDynamic, adLockOptimistic
        If rs.EOF Then
            bt(0) = 13
            bt(1) = 21
            bt(2) = 0
            bt(3) = 0
        
        Else
            If rs!pwd = pwd Then
            
                bt(0) = 13
                bt(1) = 21
                bt(2) = 1
                bt(3) = 0
                cnn.Execute "update puser set pwd  = '" & newPwd & "' where mnumber='" & userNumber & "'"
            
            Else
            
                bt(0) = 13
                bt(1) = 21
                bt(2) = 0
                bt(3) = 0
            End If
        
        
        End If
        ws.SendData bt
        
        
    Case 12  '上传私房歌
        sTokens = Split(str, ",")
        userNumber = Right(sTokens(0), Len(sTokens(0)) - 2)
        str = sTokens(1)
        For i = 1 To Len(str)
            If Mid$(str, i, 1) = ";" Then
                pwd = Left$(str, i - 1)
                songs = Right(str, Len(str) - i)
                Exit For
            End If
        Next

        If rs.State = adStateOpen Then rs.Close
        rs.Open "select * from puser where mnumber ='" & userNumber & "'", cnn, adOpenDynamic, adLockOptimistic
        If Not rs.EOF Then
            rs!songs = songs
            rs.Update
        End If
        If rs.State = adStateOpen Then rs.Close
        
        bt(0) = 13
        bt(1) = 12
        bt(2) = 1
        bt(3) = 0
        ws.SendData bt
        
    Case 10
        If rs.State = adStateOpen Then rs.Close
        
        sTokens = Split(str, ",")
        userNumber = Right(sTokens(0), Len(sTokens(0)) - 2)
        pwd = sTokens(1)
        dp = InStr(1, pwd, Chr(0), vbBinaryCompare)
        pwd = Left(pwd, dp - 1)
        rs.Open "select * from puser where mnumber='" & userNumber & "' and pwd='" & pwd & "'", cnn, adOpenDynamic, adLockOptimistic
        If rs.EOF Then
            bt(0) = 13
            bt(1) = 10
            bt(2) = 0
            bt(3) = 0
        Else
            
            bt(0) = 13
            bt(1) = 10
            bt(2) = 1
            pos = 3

            strWine = "" & rs!songs
            If rs.State = adStateOpen Then rs.Close
    
            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
                
                If pos > 4096 Then Exit For
                
            Next
            bt(pos) = 0
            
            
        End If
        
        ws.SendData bt
        

    End Select

ElseIf Fst = 12 Then

        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 Asc(Mid$(str, i, 1)) = 0 Then
                str = Mid$(str, prePos, i - 1)
                Exit For
            End If
        Next
        
If Check1.Value = 1 Then

    Select Case Scd
    
        Case 1  '保存点歌列表
            
            If rs.State = adStateOpen Then rs.Close
            rs.Open "select * from songlist where roomName = '" & RoomName & "'", cnn, adOpenDynamic, adLockOptimistic
            If Not rs.EOF Then
                rs!songname = "" & str
                rs.Update
            Else
                rs.AddNew
                rs!RoomName = RoomName
                rs!songname = "" & str
                rs.Update
            End If
            If rs.State = adStateOpen Then rs.Close
            
        Case 2  '下载点歌列表
            
            If rs.State = adStateOpen Then rs.Close
            rs.Open "select * from songlist where roomname='" & RoomName & "'", cnn, adOpenDynamic, adLockOptimistic
            bt(0) = 12
            bt(1) = 2
            pos = 2
            If Not rs.EOF Then
                strWine = rs!songname
            End If
            If rs.State = adStateOpen Then rs.Close
    
            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
                
                If pos > 4096 Then Exit For
                
            Next
            bt(pos) = 0
            ws.SendData bt
            
        Case 3  ''清除点歌列表
            cnn.Execute "update SongList set songname='' where roomName = '" & RoomName & "'"
    

    
    
    End Select
    
    
    
End If

ElseIf Fst = 13 And Scd = 22 Then
    

End If

Exit Sub

errdeal:
    List1.AddItem "数据传输错误:" & err.Description
    Exit Sub
commiterr:
    cnn.RollbackTrans
    On Error Resume Next
    
        bt(0) = 13
        bt(1) = 11
        bt(2) = 0
        bt(3) = 0
        ws.SendData bt
        
    List1.AddItem RoomName & "包厢酒水提交失败" & "错误位置:" & errPos
    Exit Sub
commiterrT:
    cnn.RollbackTrans
    On Error Resume Next
    
        bt(0) = 13
        bt(1) = 31
        bt(2) = 0
        bt(3) = 0
        ws.SendData bt
        
    List1.AddItem RoomName & "包厢酒水退货提交失败" & "错误位置:" & errPos
    Exit Sub
    
End Sub